<div dir="ltr"><p dir="ltr">Hi Mike</p>Use foldl1 then.<br><br>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,<br><br>A. thinking >>= is infixr in your "Non TH Example B" (the current issue)<br><br>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: <<a href="https://gist.github.com/aavogt/c894be768539ac9feb06">https://gist.github.com/aavogt/c894be768539ac9feb06</a>>.<br><br><p dir="ltr">Regards,</p><p dir="ltr">Adam<br></p>
<div style="margin:0px 0px 0px 0.8ex;border-left:1px solid rgb(204,204,204);padding-left:1ex">Adam,<br>
<br>
I recoded it like this:<br>
<br>
let bitsP = varP $ mkName "bits"<br>
let bitsE = varE $ mkName "bits"<br>
let combine :: [ExpQ] -> ExpQ<br>
combine = foldr1 (\ a b -> [| $a >>= $b |])<br>
let g :: Name -> ExpQ<br>
g name = [| \bits -> ifM BG.getBit (return $ $(conE name) : $bitsE) (return $bitsE) |]<br>
<br>
let makeBits = combine . map g<br>
parse <- [d| $(varP (mkName $ "parse" ++ nameBase name)) = do<br>
flags <- G.getByteString 1<br>
let r = BG.runBitGet flags (do<br>
let $bitsP = []<br>
(return [] >>= $(makeBits bitNames))<br>
return $! $bitsE)<br>
case r of<br>
Left error -> fail error<br>
Right x -> return x<br>
|]<br>
<br>
Which generates this:<br>
<br>
let bits = [];<br>
GHC.Base.return [] GHC.Base.>>=<br>
((\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.>>=<br>
((\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.>>=<br>
((\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.>>=<br>
((\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.>>=<br>
((\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.>>=<br>
((\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.>>=<br>
((\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.>>=<br>
(\bits_9 -> Control.Conditional.ifM Data.Binary.Strict.BitGet.getBit (GHC.Base.return GHC.Base.$ (I0_0 GHC.Types.: bits))<br>
(GHC.Base.return bits)))))))));<br>
<br>
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.<br>
<br>
>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.<br>
<br>
Any ideas?<br>
<br>
Mike<br>
<br>
<br>
On Mar 3, 2015, at 6:03 AM, adam vogt <<a href="mailto:vogt.adam@gmail.com" target="_blank">vogt.adam@gmail.com</a>> wrote:<br>
<br>
> Hi Mike,<br>
><br>
> Is there some reason you decided to use TH, when it looks like you can write:<br>
><br>
> f :: a -> Binary (Maybe a)<br>
> f con = do<br>
> v <- BG.getBit<br>
> return (do guard v; Just con)<br>
><br>
> makeBits :: [a] -> Binary [a]<br>
> makeBits con = catMaybes <$> mapM f con<br>
><br>
> and have the TH part be much smaller:<br>
><br>
> toCons :: [Name] -> ExpQ<br>
> toCons = listE . map conE<br>
><br>
> makeBits $(toCons bitNames)<br>
><br>
><br>
><br>
> If you really do need to generate code, let me suggest<br>
><br>
> combine :: [ExpQ] -> ExpQ<br>
> combine = foldr1 (\ a b -> [| $a >>= $b |])<br>
><br>
> together with<br>
><br>
> g :: Name -> ExpQ<br>
> g name = [| \bits -> ifM getBit ((return $(conE name) : bits) (return bits) |]<br>
><br>
> gets you<br>
><br>
> makeBits = combine . map g<br>
><br>
><br>
> Or you could keep the recursion explicit and write the first clause of<br>
> your makeBits:<br>
><br>
> makeBits [name] = g name -- g as above<br>
><br>
> Regards,<br>
> Adam<br>
><br>
><br>
> On Tue, Mar 3, 2015 at 1:05 AM, Michael Jones <<a href="mailto:mike@proclivis.com" target="_blank">mike@proclivis.com</a>> wrote:<br>
>> 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.<br>
>><br>
>> Perhaps someone will have an idea on how to fix it. I have made several attempts and failed.<br>
>><br>
>> Non TH Example A: Do notation<br>
>> —————————————<br>
>><br>
>> let r = BG.runBitGet flags (do<br>
>> let bits = []<br>
>> v <- BG.getBit<br>
>> bits <- return $ if v then I1_7:bits else bits<br>
>> v <- BG.getBit<br>
>> bits <- return $ if v then I1_6:bits else bits<br>
>> v <- BG.getBit<br>
>> bits <- return $ if v then I1_5:bits else bits<br>
>> v <- BG.getBit<br>
>> bits <- return $ if v then I1_4:bits else bits<br>
>> v <- BG.getBit<br>
>> bits <- return $ if v then I1_3:bits else bits<br>
>> v <- BG.getBit<br>
>> bits <- return $ if v then I1_2:bits else bits<br>
>> v <- BG.getBit<br>
>> bits <- return $ if v then I1_1:bits else bits<br>
>> v <- BG.getBit<br>
>> bits <- return $ if v then I1_0:bits else bits<br>
>><br>
>> return $! bits)<br>
>><br>
>><br>
>> Non TH Example B: Bind notation<br>
>> ——————————————<br>
>><br>
>> let r = BG.runBitGet flags (<br>
>> return [] >>=<br>
>> (\bits -> ifM BG.getBit (return $ I0_7:bits) (return $ bits)) >>=<br>
>> (\bits -> ifM BG.getBit (return $ I0_6:bits) (return $ bits)) >>=<br>
>> (\bits -> ifM BG.getBit (return $ I0_5:bits) (return $ bits)) >>=<br>
>> (\bits -> ifM BG.getBit (return $ I0_4:bits) (return $ bits)) >>=<br>
>> (\bits -> ifM BG.getBit (return $ I0_3:bits) (return $ bits)) >>=<br>
>> (\bits -> ifM BG.getBit (return $ I0_2:bits) (return $ bits)) >>=<br>
>> (\bits -> ifM BG.getBit (return $ I0_1:bits) (return $ bits)) >>=<br>
>> (\bits -> ifM BG.getBit (return $ I0_0:bits) (return $ bits)))<br>
>><br>
>><br>
>> A TH for Example B:<br>
>> ————————<br>
>><br>
>> let bitsP = varP $ mkName "bits"<br>
>> let bitsE = varE $ mkName "bits"<br>
>> let makeBits [] = [| "" |]<br>
>> makeBits (name:names) = [| (\bits -> ifM BG.getBit (return $ $(conE name) : $bitsE) (return $ $bitsE)) >>= $(makeBits names) |]<br>
>> parse <- [d| $(varP (mkName $ "parse" ++ nameBase name)) = do<br>
>> flags <- G.getByteString 1<br>
>> let r = BG.runBitGet flags (return [] >>= $(makeBits bitNames))<br>
>> case r of<br>
>> Left error -> fail error<br>
>> Right x -> return x<br>
>> |]<br>
>><br>
>> This generates:<br>
>><br>
>> parseTCA9535_INPUT_PORT_0_BITS = do {flags_0 <- Data.Binary.Strict.Get.getByteString 1;<br>
>> let r_1 = Data.Binary.Strict.BitGet.runBitGet flags_0<br>
>> (GHC.Base.return [] GHC.Base.>>=<br>
>> ((\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.>>=<br>
>> ((\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.>>=<br>
>> ((\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.>>=<br>
>> ((\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.>>=<br>
>> ((\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.>>=<br>
>> ((\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.>>=<br>
>> ((\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.>>=<br>
>> ((\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.>>= "")))))))));<br>
>><br>
>> Problems with TH<br>
>> ————————<br>
>><br>
>> 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.<br>
>><br>
>> 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.<br>
>><br>
>> I would prefer to use quasi quoting rather than build the whole thing with data types so that it is more readable.<br>
>><br>
>> If anyone knows of a module on hackage that does something similar, perhaps you can point me to that so I can study it.<br>
>><br>
>> Thanks…Mike<br>
>><br>
>><br>
>><br>
>><br>
>> _______________________________________________<br>
>> Haskell-Cafe mailing list<br>
>> <a href="mailto:Haskell-Cafe@haskell.org" target="_blank">Haskell-Cafe@haskell.org</a><br>
>> <a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe</a><br>
<br>
<br>
</div>
</div>