[Haskell-cafe] Difficulty making a TH template for a monadic expression
Michael Jones
mike at proclivis.com
Sun Mar 8 14:15:50 UTC 2015
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 <vogt.adam at gmail.com> wrote:
> 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/20150308/b40d6f0e/attachment.html>
More information about the Haskell-Cafe
mailing list