[Haskell-cafe] Difficulty making a TH template for a monadic expression
adam vogt
vogt.adam at gmail.com
Thu Mar 5 03:44:22 UTC 2015
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 <vogt.adam at gmail.com> 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 <mike at proclivis.com> 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 at haskell.org
>> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/haskell-cafe/attachments/20150304/1260c83b/attachment.html>
More information about the Haskell-Cafe
mailing list