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