Michael Jones mike at proclivis.com
Tue Mar 3 06:05:00 UTC 2015

```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

```