Difficulty making a TH template for a monadic expression

I’m at wits end as to how to express a monadic expression in TH. I’ll give here two ways to express a non TH version, and then a TH expression that does not quite work. It generates code that compiles, but it does not evaluate properly like the non TH version. Fundamentally, the problem is use of a recursive function using quasi quoting similar to what is in the standard Show example. Perhaps someone will have an idea on how to fix it. I have made several attempts and failed. Non TH Example A: Do notation ————————————— let r = BG.runBitGet flags (do let bits = [] v <- BG.getBit bits <- return $ if v then I1_7:bits else bits v <- BG.getBit bits <- return $ if v then I1_6:bits else bits v <- BG.getBit bits <- return $ if v then I1_5:bits else bits v <- BG.getBit bits <- return $ if v then I1_4:bits else bits v <- BG.getBit bits <- return $ if v then I1_3:bits else bits v <- BG.getBit bits <- return $ if v then I1_2:bits else bits v <- BG.getBit bits <- return $ if v then I1_1:bits else bits v <- BG.getBit bits <- return $ if v then I1_0:bits else bits return $! bits) Non TH Example B: Bind notation —————————————— let r = BG.runBitGet flags ( return [] >>= (\bits -> ifM BG.getBit (return $ I0_7:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_6:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_5:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_4:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_3:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_2:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_1:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_0:bits) (return $ bits))) A TH for Example B: ———————— let bitsP = varP $ mkName "bits" let bitsE = varE $ mkName "bits" let makeBits [] = [| "" |] makeBits (name:names) = [| (\bits -> ifM BG.getBit (return $ $(conE name) : $bitsE) (return $ $bitsE)) >>= $(makeBits names) |] parse <- [d| $(varP (mkName $ "parse" ++ nameBase name)) = do flags <- G.getByteString 1 let r = BG.runBitGet flags (return [] >>= $(makeBits bitNames)) case r of Left error -> fail error Right x -> return x |] This generates: parseTCA9535_INPUT_PORT_0_BITS = do {flags_0 <- Data.Binary.Strict.Get.getByteString 1; let r_1 = Data.Binary.Strict.BitGet.runBitGet flags_0 (GHC.Base.return [] GHC.Base.>>= ((\bits_2 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_7 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_3 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_6 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_4 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_5 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_5 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_4 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_6 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_3 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_7 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_2 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_8 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_1 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_9 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_0 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ""))))))))); Problems with TH ———————— The problem is the () that interferes with the order of evaluation, and the termination at the end ( “” ). I’m no so worried about the termination. I can put something harmless there. The parens are the main problem. Calling a quasi quoter recursively is the cause, as it nests the evaluation. I tried things like building the bits in a list, but that does not work because the BG.getBit has to run in the BitGit monad. I know I can write a simple evaluation that just returns a list of Bools and only TH for bit names, but in the final version the size of bit fields needs to be dynamic, so I need to dynamically generate code piece by piece. I would prefer to use quasi quoting rather than build the whole thing with data types so that it is more readable. If anyone knows of a module on hackage that does something similar, perhaps you can point me to that so I can study it. Thanks…Mike

Hi Mike,
Is there some reason you decided to use TH, when it looks like you can write:
f :: a -> Binary (Maybe a)
f con = do
v <- BG.getBit
return (do guard v; Just con)
makeBits :: [a] -> Binary [a]
makeBits con = catMaybes <$> mapM f con
and have the TH part be much smaller:
toCons :: [Name] -> ExpQ
toCons = listE . map conE
makeBits $(toCons bitNames)
If you really do need to generate code, let me suggest
combine :: [ExpQ] -> ExpQ
combine = foldr1 (\ a b -> [| $a >>= $b |])
together with
g :: Name -> ExpQ
g name = [| \bits -> ifM getBit ((return $(conE name) : bits) (return bits) |]
gets you
makeBits = combine . map g
Or you could keep the recursion explicit and write the first clause of
your makeBits:
makeBits [name] = g name -- g as above
Regards,
Adam
On Tue, Mar 3, 2015 at 1:05 AM, Michael Jones
I’m at wits end as to how to express a monadic expression in TH. I’ll give here two ways to express a non TH version, and then a TH expression that does not quite work. It generates code that compiles, but it does not evaluate properly like the non TH version. Fundamentally, the problem is use of a recursive function using quasi quoting similar to what is in the standard Show example.
Perhaps someone will have an idea on how to fix it. I have made several attempts and failed.
Non TH Example A: Do notation —————————————
let r = BG.runBitGet flags (do let bits = [] v <- BG.getBit bits <- return $ if v then I1_7:bits else bits v <- BG.getBit bits <- return $ if v then I1_6:bits else bits v <- BG.getBit bits <- return $ if v then I1_5:bits else bits v <- BG.getBit bits <- return $ if v then I1_4:bits else bits v <- BG.getBit bits <- return $ if v then I1_3:bits else bits v <- BG.getBit bits <- return $ if v then I1_2:bits else bits v <- BG.getBit bits <- return $ if v then I1_1:bits else bits v <- BG.getBit bits <- return $ if v then I1_0:bits else bits
return $! bits)
Non TH Example B: Bind notation ——————————————
let r = BG.runBitGet flags ( return [] >>= (\bits -> ifM BG.getBit (return $ I0_7:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_6:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_5:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_4:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_3:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_2:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_1:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_0:bits) (return $ bits)))
A TH for Example B: ————————
let bitsP = varP $ mkName "bits" let bitsE = varE $ mkName "bits" let makeBits [] = [| "" |] makeBits (name:names) = [| (\bits -> ifM BG.getBit (return $ $(conE name) : $bitsE) (return $ $bitsE)) >>= $(makeBits names) |] parse <- [d| $(varP (mkName $ "parse" ++ nameBase name)) = do flags <- G.getByteString 1 let r = BG.runBitGet flags (return [] >>= $(makeBits bitNames)) case r of Left error -> fail error Right x -> return x |]
This generates:
parseTCA9535_INPUT_PORT_0_BITS = do {flags_0 <- Data.Binary.Strict.Get.getByteString 1; let r_1 = Data.Binary.Strict.BitGet.runBitGet flags_0 (GHC.Base.return [] GHC.Base.>>= ((\bits_2 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_7 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_3 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_6 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_4 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_5 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_5 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_4 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_6 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_3 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_7 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_2 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_8 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_1 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_9 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_0 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= "")))))))));
Problems with TH ————————
The problem is the () that interferes with the order of evaluation, and the termination at the end ( “” ). I’m no so worried about the termination. I can put something harmless there. The parens are the main problem. Calling a quasi quoter recursively is the cause, as it nests the evaluation.
I tried things like building the bits in a list, but that does not work because the BG.getBit has to run in the BitGit monad. I know I can write a simple evaluation that just returns a list of Bools and only TH for bit names, but in the final version the size of bit fields needs to be dynamic, so I need to dynamically generate code piece by piece.
I would prefer to use quasi quoting rather than build the whole thing with data types so that it is more readable.
If anyone knows of a module on hackage that does something similar, perhaps you can point me to that so I can study it.
Thanks…Mike
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe

Adam,
I used TH because I wanted a non-programmer to write simple statements from data sheets that generated code for a programmer. My ignorance may prove my undoing, but if I learn something by going down a rabbit hole, I can recover.
I don’t need to implement g necessarily, as it is part of a larger function generating other TH code, f would be fine.
The goal is to have a non-programmer write something like:
$(makeCommandData (mkName "RegTCA9535") ["INPUT_PORT_0",
"INPUT_PORT_1",
"OUTPUT_PORT_0",
"OUTPUT_PORT_1",
"POLARITY_INVERSION_PORT_0",
"POLARITY_INVERSION_PORT_1",
"CONFIGURATION_PORT_0",
"CONFIGURATION_PORT_1"])
(makeBitData (mkName "TCA9535_INPUT_PORT_0_BITS") [mkName "I0_7",
"I0_6",
"I0_5",
"I0_4",
"I0_3",
"I0_2",
"I0_1",
"I0_0”])
MORE REGISTERS HERE
and generate a complete API that works off a list of bits, and read/writes SMBus.
I have a GSOC project posted here: http://elinux.org/Minnowboard:GSoC2015
The code I am working on here is kind of starter code for that. I already have an SMBus API and impl as well on a MinnowBoardMax running Ubuntu.
If any students are interested, follow the link.
Mike
On Mar 3, 2015, at 6:03 AM, adam vogt
Hi Mike,
Is there some reason you decided to use TH, when it looks like you can write:
f :: a -> Binary (Maybe a) f con = do v <- BG.getBit return (do guard v; Just con)
makeBits :: [a] -> Binary [a] makeBits con = catMaybes <$> mapM f con
and have the TH part be much smaller:
toCons :: [Name] -> ExpQ toCons = listE . map conE
makeBits $(toCons bitNames)
If you really do need to generate code, let me suggest
combine :: [ExpQ] -> ExpQ combine = foldr1 (\ a b -> [| $a >>= $b |])
together with
g :: Name -> ExpQ g name = [| \bits -> ifM getBit ((return $(conE name) : bits) (return bits) |]
gets you
makeBits = combine . map g
Or you could keep the recursion explicit and write the first clause of your makeBits:
makeBits [name] = g name -- g as above
Regards, Adam
On Tue, Mar 3, 2015 at 1:05 AM, Michael Jones
wrote: I’m at wits end as to how to express a monadic expression in TH. I’ll give here two ways to express a non TH version, and then a TH expression that does not quite work. It generates code that compiles, but it does not evaluate properly like the non TH version. Fundamentally, the problem is use of a recursive function using quasi quoting similar to what is in the standard Show example.
Perhaps someone will have an idea on how to fix it. I have made several attempts and failed.
Non TH Example A: Do notation —————————————
let r = BG.runBitGet flags (do let bits = [] v <- BG.getBit bits <- return $ if v then I1_7:bits else bits v <- BG.getBit bits <- return $ if v then I1_6:bits else bits v <- BG.getBit bits <- return $ if v then I1_5:bits else bits v <- BG.getBit bits <- return $ if v then I1_4:bits else bits v <- BG.getBit bits <- return $ if v then I1_3:bits else bits v <- BG.getBit bits <- return $ if v then I1_2:bits else bits v <- BG.getBit bits <- return $ if v then I1_1:bits else bits v <- BG.getBit bits <- return $ if v then I1_0:bits else bits
return $! bits)
Non TH Example B: Bind notation ——————————————
let r = BG.runBitGet flags ( return [] >>= (\bits -> ifM BG.getBit (return $ I0_7:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_6:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_5:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_4:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_3:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_2:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_1:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_0:bits) (return $ bits)))
A TH for Example B: ————————
let bitsP = varP $ mkName "bits" let bitsE = varE $ mkName "bits" let makeBits [] = [| "" |] makeBits (name:names) = [| (\bits -> ifM BG.getBit (return $ $(conE name) : $bitsE) (return $ $bitsE)) >>= $(makeBits names) |] parse <- [d| $(varP (mkName $ "parse" ++ nameBase name)) = do flags <- G.getByteString 1 let r = BG.runBitGet flags (return [] >>= $(makeBits bitNames)) case r of Left error -> fail error Right x -> return x |]
This generates:
parseTCA9535_INPUT_PORT_0_BITS = do {flags_0 <- Data.Binary.Strict.Get.getByteString 1; let r_1 = Data.Binary.Strict.BitGet.runBitGet flags_0 (GHC.Base.return [] GHC.Base.>>= ((\bits_2 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_7 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_3 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_6 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_4 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_5 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_5 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_4 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_6 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_3 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_7 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_2 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_8 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_1 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_9 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_0 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= "")))))))));
Problems with TH ————————
The problem is the () that interferes with the order of evaluation, and the termination at the end ( “” ). I’m no so worried about the termination. I can put something harmless there. The parens are the main problem. Calling a quasi quoter recursively is the cause, as it nests the evaluation.
I tried things like building the bits in a list, but that does not work because the BG.getBit has to run in the BitGit monad. I know I can write a simple evaluation that just returns a list of Bools and only TH for bit names, but in the final version the size of bit fields needs to be dynamic, so I need to dynamically generate code piece by piece.
I would prefer to use quasi quoting rather than build the whole thing with data types so that it is more readable.
If anyone knows of a module on hackage that does something similar, perhaps you can point me to that so I can study it.
Thanks…Mike
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe

I failed to strip all the mkNames from the example. They are in the current code but will be moved inside the make functions later. So...
$(makeCommandData ("RegTCA9535") ["INPUT_PORT_0", "INPUT_PORT_1", "OUTPUT_PORT_0", "OUTPUT_PORT_1", "POLARITY_INVERSION_PORT_0", "POLARITY_INVERSION_PORT_1", "CONFIGURATION_PORT_0", "CONFIGURATION_PORT_1"])
(makeBitData ("TCA9535_INPUT_PORT_0_BITS") ["I0_7", "I0_6", "I0_5", "I0_4", "I0_3", "I0_2", "I0_1", "I0_0”])
On Mar 3, 2015, at 9:00 AM, Michael Jones
Adam,
I used TH because I wanted a non-programmer to write simple statements from data sheets that generated code for a programmer. My ignorance may prove my undoing, but if I learn something by going down a rabbit hole, I can recover.
I don’t need to implement g necessarily, as it is part of a larger function generating other TH code, f would be fine.
The goal is to have a non-programmer write something like:
$(makeCommandData (mkName "RegTCA9535") ["INPUT_PORT_0", "INPUT_PORT_1", "OUTPUT_PORT_0", "OUTPUT_PORT_1", "POLARITY_INVERSION_PORT_0", "POLARITY_INVERSION_PORT_1", "CONFIGURATION_PORT_0", "CONFIGURATION_PORT_1"])
(makeBitData (mkName "TCA9535_INPUT_PORT_0_BITS") [mkName "I0_7", "I0_6", "I0_5", "I0_4", "I0_3", "I0_2", "I0_1", "I0_0”])
MORE REGISTERS HERE
and generate a complete API that works off a list of bits, and read/writes SMBus.
I have a GSOC project posted here: http://elinux.org/Minnowboard:GSoC2015
The code I am working on here is kind of starter code for that. I already have an SMBus API and impl as well on a MinnowBoardMax running Ubuntu.
If any students are interested, follow the link.
Mike
On Mar 3, 2015, at 6:03 AM, adam vogt
wrote: Hi Mike,
Is there some reason you decided to use TH, when it looks like you can write:
f :: a -> Binary (Maybe a) f con = do v <- BG.getBit return (do guard v; Just con)
makeBits :: [a] -> Binary [a] makeBits con = catMaybes <$> mapM f con
and have the TH part be much smaller:
toCons :: [Name] -> ExpQ toCons = listE . map conE
makeBits $(toCons bitNames)
If you really do need to generate code, let me suggest
combine :: [ExpQ] -> ExpQ combine = foldr1 (\ a b -> [| $a >>= $b |])
together with
g :: Name -> ExpQ g name = [| \bits -> ifM getBit ((return $(conE name) : bits) (return bits) |]
gets you
makeBits = combine . map g
Or you could keep the recursion explicit and write the first clause of your makeBits:
makeBits [name] = g name -- g as above
Regards, Adam
On Tue, Mar 3, 2015 at 1:05 AM, Michael Jones
wrote: I’m at wits end as to how to express a monadic expression in TH. I’ll give here two ways to express a non TH version, and then a TH expression that does not quite work. It generates code that compiles, but it does not evaluate properly like the non TH version. Fundamentally, the problem is use of a recursive function using quasi quoting similar to what is in the standard Show example.
Perhaps someone will have an idea on how to fix it. I have made several attempts and failed.
Non TH Example A: Do notation —————————————
let r = BG.runBitGet flags (do let bits = [] v <- BG.getBit bits <- return $ if v then I1_7:bits else bits v <- BG.getBit bits <- return $ if v then I1_6:bits else bits v <- BG.getBit bits <- return $ if v then I1_5:bits else bits v <- BG.getBit bits <- return $ if v then I1_4:bits else bits v <- BG.getBit bits <- return $ if v then I1_3:bits else bits v <- BG.getBit bits <- return $ if v then I1_2:bits else bits v <- BG.getBit bits <- return $ if v then I1_1:bits else bits v <- BG.getBit bits <- return $ if v then I1_0:bits else bits
return $! bits)
Non TH Example B: Bind notation ——————————————
let r = BG.runBitGet flags ( return [] >>= (\bits -> ifM BG.getBit (return $ I0_7:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_6:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_5:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_4:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_3:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_2:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_1:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_0:bits) (return $ bits)))
A TH for Example B: ————————
let bitsP = varP $ mkName "bits" let bitsE = varE $ mkName "bits" let makeBits [] = [| "" |] makeBits (name:names) = [| (\bits -> ifM BG.getBit (return $ $(conE name) : $bitsE) (return $ $bitsE)) >>= $(makeBits names) |] parse <- [d| $(varP (mkName $ "parse" ++ nameBase name)) = do flags <- G.getByteString 1 let r = BG.runBitGet flags (return [] >>= $(makeBits bitNames)) case r of Left error -> fail error Right x -> return x |]
This generates:
parseTCA9535_INPUT_PORT_0_BITS = do {flags_0 <- Data.Binary.Strict.Get.getByteString 1; let r_1 = Data.Binary.Strict.BitGet.runBitGet flags_0 (GHC.Base.return [] GHC.Base.>>= ((\bits_2 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_7 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_3 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_6 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_4 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_5 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_5 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_4 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_6 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_3 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_7 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_2 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_8 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_1 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_9 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_0 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= "")))))))));
Problems with TH ————————
The problem is the () that interferes with the order of evaluation, and the termination at the end ( “” ). I’m no so worried about the termination. I can put something harmless there. The parens are the main problem. Calling a quasi quoter recursively is the cause, as it nests the evaluation.
I tried things like building the bits in a list, but that does not work because the BG.getBit has to run in the BitGit monad. I know I can write a simple evaluation that just returns a list of Bools and only TH for bit names, but in the final version the size of bit fields needs to be dynamic, so I need to dynamically generate code piece by piece.
I would prefer to use quasi quoting rather than build the whole thing with data types so that it is more readable.
If anyone knows of a module on hackage that does something similar, perhaps you can point me to that so I can study it.
Thanks…Mike
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe

Adam,
I recoded it like this:
let bitsP = varP $ mkName "bits"
let bitsE = varE $ mkName "bits"
let combine :: [ExpQ] -> ExpQ
combine = foldr1 (\ a b -> [| $a >>= $b |])
let g :: Name -> ExpQ
g name = [| \bits -> ifM BG.getBit (return $ $(conE name) : $bitsE) (return $bitsE) |]
let makeBits = combine . map g
parse <- [d| $(varP (mkName $ "parse" ++ nameBase name)) = do
flags <- G.getByteString 1
let r = BG.runBitGet flags (do
let $bitsP = []
(return [] >>= $(makeBits bitNames))
return $! $bitsE)
case r of
Left error -> fail error
Right x -> return x
|]
Which generates this:
let bits = [];
GHC.Base.return [] GHC.Base.>>=
((\bits_2 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_7 GHC.Types.: bits)) (GHC.Base.return bits)) GHC.Base.>>=
((\bits_3 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_6 GHC.Types.: bits)) (GHC.Base.return bits)) GHC.Base.>>=
((\bits_4 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_5 GHC.Types.: bits)) (GHC.Base.return bits)) GHC.Base.>>=
((\bits_5 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_4 GHC.Types.: bits)) (GHC.Base.return bits)) GHC.Base.>>=
((\bits_6 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_3 GHC.Types.: bits)) (GHC.Base.return bits)) GHC.Base.>>=
((\bits_7 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_2 GHC.Types.: bits)) (GHC.Base.return bits)) GHC.Base.>>=
((\bits_8 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_1 GHC.Types.: bits)) (GHC.Base.return bits)) GHC.Base.>>=
(\bits_9 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_0 GHC.Types.: bits))
(GHC.Base.return bits)))))))));
But it does not compile due to the nesting brackets. The fold nests the functions just like my recursive quasi quoting. So I think the real question is how to connect each function end to end, which is more like composition using the >>= operation.
From some previous things I tried, I think the code in the quasi quote must be a complete expression, which makes sense to me. But that is what makes it hard to glue together.
Any ideas?
Mike
On Mar 3, 2015, at 6:03 AM, adam vogt
Hi Mike,
Is there some reason you decided to use TH, when it looks like you can write:
f :: a -> Binary (Maybe a) f con = do v <- BG.getBit return (do guard v; Just con)
makeBits :: [a] -> Binary [a] makeBits con = catMaybes <$> mapM f con
and have the TH part be much smaller:
toCons :: [Name] -> ExpQ toCons = listE . map conE
makeBits $(toCons bitNames)
If you really do need to generate code, let me suggest
combine :: [ExpQ] -> ExpQ combine = foldr1 (\ a b -> [| $a >>= $b |])
together with
g :: Name -> ExpQ g name = [| \bits -> ifM getBit ((return $(conE name) : bits) (return bits) |]
gets you
makeBits = combine . map g
Or you could keep the recursion explicit and write the first clause of your makeBits:
makeBits [name] = g name -- g as above
Regards, Adam
On Tue, Mar 3, 2015 at 1:05 AM, Michael Jones
wrote: I’m at wits end as to how to express a monadic expression in TH. I’ll give here two ways to express a non TH version, and then a TH expression that does not quite work. It generates code that compiles, but it does not evaluate properly like the non TH version. Fundamentally, the problem is use of a recursive function using quasi quoting similar to what is in the standard Show example.
Perhaps someone will have an idea on how to fix it. I have made several attempts and failed.
Non TH Example A: Do notation —————————————
let r = BG.runBitGet flags (do let bits = [] v <- BG.getBit bits <- return $ if v then I1_7:bits else bits v <- BG.getBit bits <- return $ if v then I1_6:bits else bits v <- BG.getBit bits <- return $ if v then I1_5:bits else bits v <- BG.getBit bits <- return $ if v then I1_4:bits else bits v <- BG.getBit bits <- return $ if v then I1_3:bits else bits v <- BG.getBit bits <- return $ if v then I1_2:bits else bits v <- BG.getBit bits <- return $ if v then I1_1:bits else bits v <- BG.getBit bits <- return $ if v then I1_0:bits else bits
return $! bits)
Non TH Example B: Bind notation ——————————————
let r = BG.runBitGet flags ( return [] >>= (\bits -> ifM BG.getBit (return $ I0_7:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_6:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_5:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_4:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_3:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_2:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_1:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_0:bits) (return $ bits)))
A TH for Example B: ————————
let bitsP = varP $ mkName "bits" let bitsE = varE $ mkName "bits" let makeBits [] = [| "" |] makeBits (name:names) = [| (\bits -> ifM BG.getBit (return $ $(conE name) : $bitsE) (return $ $bitsE)) >>= $(makeBits names) |] parse <- [d| $(varP (mkName $ "parse" ++ nameBase name)) = do flags <- G.getByteString 1 let r = BG.runBitGet flags (return [] >>= $(makeBits bitNames)) case r of Left error -> fail error Right x -> return x |]
This generates:
parseTCA9535_INPUT_PORT_0_BITS = do {flags_0 <- Data.Binary.Strict.Get.getByteString 1; let r_1 = Data.Binary.Strict.BitGet.runBitGet flags_0 (GHC.Base.return [] GHC.Base.>>= ((\bits_2 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_7 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_3 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_6 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_4 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_5 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_5 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_4 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_6 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_3 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_7 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_2 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_8 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_1 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_9 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_0 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= "")))))))));
Problems with TH ————————
The problem is the () that interferes with the order of evaluation, and the termination at the end ( “” ). I’m no so worried about the termination. I can put something harmless there. The parens are the main problem. Calling a quasi quoter recursively is the cause, as it nests the evaluation.
I tried things like building the bits in a list, but that does not work because the BG.getBit has to run in the BitGit monad. I know I can write a simple evaluation that just returns a list of Bools and only TH for bit names, but in the final version the size of bit fields needs to be dynamic, so I need to dynamically generate code piece by piece.
I would prefer to use quasi quoting rather than build the whole thing with data types so that it is more readable.
If anyone knows of a module on hackage that does something similar, perhaps you can point me to that so I can study it.
Thanks…Mike
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe

Hi Mike Use foldl1 then. But I think you're better off not unrolling the loop(s) that the "makeBits $(toCons bitNames)" option does, since that makes your code shorter so there are less things that go wrong. For example, A. thinking >>= is infixr in your "Non TH Example B" (the current issue) B. suspicious things like using $bitsE instead of bits. Depending on what bitsE is defined as, it doesn't have to evaluate to the closest bits-named variable: https://gist.github.com/aavogt/c894be768539ac9feb06. Regards, Adam Adam, I recoded it like this: let bitsP = varP $ mkName "bits" let bitsE = varE $ mkName "bits" let combine :: [ExpQ] -> ExpQ combine = foldr1 (\ a b -> [| $a >>= $b |]) let g :: Name -> ExpQ g name = [| \bits -> ifM BG.getBit (return $ $(conE name) : $bitsE) (return $bitsE) |] let makeBits = combine . map g parse <- [d| $(varP (mkName $ "parse" ++ nameBase name)) = do flags <- G.getByteString 1 let r = BG.runBitGet flags (do let $bitsP = [] (return [] >>= $(makeBits bitNames)) return $! $bitsE) case r of Left error -> fail error Right x -> return x |] Which generates this: let bits = []; GHC.Base.return [] GHC.Base.>>= ((\bits_2 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_7 GHC.Types.: bits)) (GHC.Base.return bits)) GHC.Base.>>= ((\bits_3 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_6 GHC.Types.: bits)) (GHC.Base.return bits)) GHC.Base.>>= ((\bits_4 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_5 GHC.Types.: bits)) (GHC.Base.return bits)) GHC.Base.>>= ((\bits_5 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_4 GHC.Types.: bits)) (GHC.Base.return bits)) GHC.Base.>>= ((\bits_6 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_3 GHC.Types.: bits)) (GHC.Base.return bits)) GHC.Base.>>= ((\bits_7 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_2 GHC.Types.: bits)) (GHC.Base.return bits)) GHC.Base.>>= ((\bits_8 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_1 GHC.Types.: bits)) (GHC.Base.return bits)) GHC.Base.>>= (\bits_9 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_0 GHC.Types.: bits)) (GHC.Base.return bits))))))))); But it does not compile due to the nesting brackets. The fold nests the functions just like my recursive quasi quoting. So I think the real question is how to connect each function end to end, which is more like composition using the >>= operation.
From some previous things I tried, I think the code in the quasi quote must be a complete expression, which makes sense to me. But that is what makes it hard to glue together.
Hi Mike,
Is there some reason you decided to use TH, when it looks like you can write:
f :: a -> Binary (Maybe a) f con = do v <- BG.getBit return (do guard v; Just con)
makeBits :: [a] -> Binary [a] makeBits con = catMaybes <$> mapM f con
and have the TH part be much smaller:
toCons :: [Name] -> ExpQ toCons = listE . map conE
makeBits $(toCons bitNames)
If you really do need to generate code, let me suggest
combine :: [ExpQ] -> ExpQ combine = foldr1 (\ a b -> [| $a >>= $b |])
together with
g :: Name -> ExpQ g name = [| \bits -> ifM getBit ((return $(conE name) : bits) (return bits) |]
gets you
makeBits = combine . map g
Or you could keep the recursion explicit and write the first clause of your makeBits:
makeBits [name] = g name -- g as above
Regards, Adam
On Tue, Mar 3, 2015 at 1:05 AM, Michael Jones
wrote: I’m at wits end as to how to express a monadic expression in TH. I’ll give here two ways to express a non TH version, and then a TH expression
Perhaps someone will have an idea on how to fix it. I have made several
attempts and failed.
Non TH Example A: Do notation —————————————
let r = BG.runBitGet flags (do let bits = [] v <- BG.getBit bits <- return $ if v then I1_7:bits else bits v <- BG.getBit bits <- return $ if v then I1_6:bits else bits v <- BG.getBit bits <- return $ if v then I1_5:bits else bits v <- BG.getBit bits <- return $ if v then I1_4:bits else bits v <- BG.getBit bits <- return $ if v then I1_3:bits else bits v <- BG.getBit bits <- return $ if v then I1_2:bits else bits v <- BG.getBit bits <- return $ if v then I1_1:bits else bits v <- BG.getBit bits <- return $ if v then I1_0:bits else bits
return $! bits)
Non TH Example B: Bind notation ——————————————
let r = BG.runBitGet flags ( return [] >>= (\bits -> ifM BG.getBit (return $ I0_7:bits) (return $ bits)) = (\bits -> ifM BG.getBit (return $ I0_6:bits) (return $ bits)) = (\bits -> ifM BG.getBit (return $ I0_5:bits) (return $ bits)) = (\bits -> ifM BG.getBit (return $ I0_4:bits) (return $ bits)) = (\bits -> ifM BG.getBit (return $ I0_3:bits) (return $ bits)) = (\bits -> ifM BG.getBit (return $ I0_2:bits) (return $ bits)) = (\bits -> ifM BG.getBit (return $ I0_1:bits) (return $ bits)) = (\bits -> ifM BG.getBit (return $ I0_0:bits) (return $ bits)))
A TH for Example B: ————————
let bitsP = varP $ mkName "bits" let bitsE = varE $ mkName "bits" let makeBits [] = [| "" |] makeBits (name:names) = [| (\bits -> ifM BG.getBit (return $
$(conE name) : $bitsE) (return $ $bitsE)) >>= $(makeBits names) |]
parse <- [d| $(varP (mkName $ "parse" ++ nameBase name)) = do flags <- G.getByteString 1 let r = BG.runBitGet flags (return [] >>= $(makeBits bitNames)) case r of Left error -> fail error Right x -> return x |]
This generates:
parseTCA9535_INPUT_PORT_0_BITS = do {flags_0 <- Data.Binary.Strict.Get.getByteString 1; let r_1 = Data.Binary.Strict.BitGet.runBitGet flags_0 (GHC.Base.return [] GHC.Base.>>= ((\bits_2 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_7 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_3 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_6 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_4 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_5 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_5 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_4 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_6 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_3 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_7 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_2 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_8 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_1 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_9 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_0 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= "")))))))));
Problems with TH ————————
The problem is the () that interferes with the order of evaluation, and
I tried things like building the bits in a list, but that does not work
because the BG.getBit has to run in the BitGit monad. I know I can write a simple evaluation that just returns a list of Bools and only TH for bit names, but in the final version the size of bit fields needs to be dynamic, so I need to dynamically generate code piece by piece.
I would prefer to use quasi quoting rather than build the whole thing
with data types so that it is more readable.
If anyone knows of a module on hackage that does something similar,
Any ideas?
Mike
On Mar 3, 2015, at 6:03 AM, adam vogt
Thanks…Mike
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe

Adam,
Attached is a working function. I have not followed up on your final suggestions, because I am still considering the best way to represent bit fields, empty bits, mixed read/write only bits, etc. I’ll optimize when I find a final structure. But at least I was able to get a prototype working that could twiddle bits on an I2C device and I know how to build expressions with >>=.
Many many thanks. Mike.
let bitsP = varP $ mkName "bits"
let bitsE = varE $ mkName "bits"
let combine :: [ExpQ] -> ExpQ
combine = foldl1 (\ a b -> [| $a >>= $b |])
let g :: Name -> ExpQ
g regName' = [| \bits -> ifM BG.getBit (return $ (((fromIntegral . fromEnum) $(conE regName'))::Word16) : $bitsE) (return $bitsE) |]
let h = [| return [] |]
let makeBits names = combine (h : map g names)
parse <- [d| $(varP (mkName $ "parse" ++ nameBase regName')) = do
flags <- G.getByteString 1
let r = BG.runBitGet flags (do
let $bitsP = []
$(makeBits (reverse bitNames'))
return $! $bitsE)
case r of
Left error -> fail error
Right x -> return x
|]
On Mar 4, 2015, at 8:44 PM, adam vogt
Hi Mike
Use foldl1 then.
But I think you're better off not unrolling the loop(s) that the "makeBits $(toCons bitNames)" option does, since that makes your code shorter so there are less things that go wrong. For example,
A. thinking >>= is infixr in your "Non TH Example B" (the current issue)
B. suspicious things like using $bitsE instead of bits. Depending on what bitsE is defined as, it doesn't have to evaluate to the closest bits-named variable: https://gist.github.com/aavogt/c894be768539ac9feb06.
Regards,
Adam
Adam,
I recoded it like this:
let bitsP = varP $ mkName "bits" let bitsE = varE $ mkName "bits" let combine :: [ExpQ] -> ExpQ combine = foldr1 (\ a b -> [| $a >>= $b |]) let g :: Name -> ExpQ g name = [| \bits -> ifM BG.getBit (return $ $(conE name) : $bitsE) (return $bitsE) |]
let makeBits = combine . map g parse <- [d| $(varP (mkName $ "parse" ++ nameBase name)) = do flags <- G.getByteString 1 let r = BG.runBitGet flags (do let $bitsP = [] (return [] >>= $(makeBits bitNames)) return $! $bitsE) case r of Left error -> fail error Right x -> return x |]
Which generates this:
let bits = []; GHC.Base.return [] GHC.Base.>>= ((\bits_2 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_7 GHC.Types.: bits)) (GHC.Base.return bits)) GHC.Base.>>= ((\bits_3 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_6 GHC.Types.: bits)) (GHC.Base.return bits)) GHC.Base.>>= ((\bits_4 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_5 GHC.Types.: bits)) (GHC.Base.return bits)) GHC.Base.>>= ((\bits_5 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_4 GHC.Types.: bits)) (GHC.Base.return bits)) GHC.Base.>>= ((\bits_6 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_3 GHC.Types.: bits)) (GHC.Base.return bits)) GHC.Base.>>= ((\bits_7 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_2 GHC.Types.: bits)) (GHC.Base.return bits)) GHC.Base.>>= ((\bits_8 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_1 GHC.Types.: bits)) (GHC.Base.return bits)) GHC.Base.>>= (\bits_9 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_0 GHC.Types.: bits)) (GHC.Base.return bits)))))))));
But it does not compile due to the nesting brackets. The fold nests the functions just like my recursive quasi quoting. So I think the real question is how to connect each function end to end, which is more like composition using the >>= operation.
From some previous things I tried, I think the code in the quasi quote must be a complete expression, which makes sense to me. But that is what makes it hard to glue together.
Any ideas?
Mike
On Mar 3, 2015, at 6:03 AM, adam vogt
wrote: Hi Mike,
Is there some reason you decided to use TH, when it looks like you can write:
f :: a -> Binary (Maybe a) f con = do v <- BG.getBit return (do guard v; Just con)
makeBits :: [a] -> Binary [a] makeBits con = catMaybes <$> mapM f con
and have the TH part be much smaller:
toCons :: [Name] -> ExpQ toCons = listE . map conE
makeBits $(toCons bitNames)
If you really do need to generate code, let me suggest
combine :: [ExpQ] -> ExpQ combine = foldr1 (\ a b -> [| $a >>= $b |])
together with
g :: Name -> ExpQ g name = [| \bits -> ifM getBit ((return $(conE name) : bits) (return bits) |]
gets you
makeBits = combine . map g
Or you could keep the recursion explicit and write the first clause of your makeBits:
makeBits [name] = g name -- g as above
Regards, Adam
On Tue, Mar 3, 2015 at 1:05 AM, Michael Jones
wrote: I’m at wits end as to how to express a monadic expression in TH. I’ll give here two ways to express a non TH version, and then a TH expression that does not quite work. It generates code that compiles, but it does not evaluate properly like the non TH version. Fundamentally, the problem is use of a recursive function using quasi quoting similar to what is in the standard Show example.
Perhaps someone will have an idea on how to fix it. I have made several attempts and failed.
Non TH Example A: Do notation —————————————
let r = BG.runBitGet flags (do let bits = [] v <- BG.getBit bits <- return $ if v then I1_7:bits else bits v <- BG.getBit bits <- return $ if v then I1_6:bits else bits v <- BG.getBit bits <- return $ if v then I1_5:bits else bits v <- BG.getBit bits <- return $ if v then I1_4:bits else bits v <- BG.getBit bits <- return $ if v then I1_3:bits else bits v <- BG.getBit bits <- return $ if v then I1_2:bits else bits v <- BG.getBit bits <- return $ if v then I1_1:bits else bits v <- BG.getBit bits <- return $ if v then I1_0:bits else bits
return $! bits)
Non TH Example B: Bind notation ——————————————
let r = BG.runBitGet flags ( return [] >>= (\bits -> ifM BG.getBit (return $ I0_7:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_6:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_5:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_4:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_3:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_2:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_1:bits) (return $ bits)) >>= (\bits -> ifM BG.getBit (return $ I0_0:bits) (return $ bits)))
A TH for Example B: ————————
let bitsP = varP $ mkName "bits" let bitsE = varE $ mkName "bits" let makeBits [] = [| "" |] makeBits (name:names) = [| (\bits -> ifM BG.getBit (return $ $(conE name) : $bitsE) (return $ $bitsE)) >>= $(makeBits names) |] parse <- [d| $(varP (mkName $ "parse" ++ nameBase name)) = do flags <- G.getByteString 1 let r = BG.runBitGet flags (return [] >>= $(makeBits bitNames)) case r of Left error -> fail error Right x -> return x |]
This generates:
parseTCA9535_INPUT_PORT_0_BITS = do {flags_0 <- Data.Binary.Strict.Get.getByteString 1; let r_1 = Data.Binary.Strict.BitGet.runBitGet flags_0 (GHC.Base.return [] GHC.Base.>>= ((\bits_2 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_7 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_3 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_6 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_4 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_5 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_5 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_4 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_6 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_3 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_7 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_2 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_8 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_1 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= ((\bits_9 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_0 GHC.Types.: bits)) (GHC.Base.return GHC.Base.$ bits)) GHC.Base.>>= "")))))))));
Problems with TH ————————
The problem is the () that interferes with the order of evaluation, and the termination at the end ( “” ). I’m no so worried about the termination. I can put something harmless there. The parens are the main problem. Calling a quasi quoter recursively is the cause, as it nests the evaluation.
I tried things like building the bits in a list, but that does not work because the BG.getBit has to run in the BitGit monad. I know I can write a simple evaluation that just returns a list of Bools and only TH for bit names, but in the final version the size of bit fields needs to be dynamic, so I need to dynamically generate code piece by piece.
I would prefer to use quasi quoting rather than build the whole thing with data types so that it is more readable.
If anyone knows of a module on hackage that does something similar, perhaps you can point me to that so I can study it.
Thanks…Mike
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
participants (2)
-
adam vogt
-
Michael Jones