[Haskell-cafe] AST Rewriting
Gershom Bazerman
gershomb at gmail.com
Wed Nov 21 05:45:28 CET 2012
On 11/20/12 6:21 PM, Steve Severance wrote:
> class (ReflectDescriptor a, Typeable a, Wire a) => ProtoBuf a
>
> data Expression a b where
> OpenTable :: (ProtoBuf b) => Int -> Table -> Expression () b
> OpenFile :: (ProtoBuf b) => Int -> String -> Expression () b
> WriteFile :: (Typeable a, ProtoBuf b) => Int -> String -> Expression
> a b -> Expression b ()
> WriteTable :: (Typeable a, ProtoBuf b) => Int -> Table -> Expression
> a b -> Expression b ()
> Map :: (ProtoBuf a, ProtoBuf b, ProtoBuf c) => Int -> (a -> b) ->
> Expression c a -> Expression a b
> LocalMerge :: (ProtoBuf a) => Int -> [Expression c a] -> Expression c a
We can implement a version of the compos operator like so:
compos :: forall m c d. (forall a. a -> m a) -> (forall a b. m (a -> b)
-> m a -> m b)
-> (forall e f. Expression e f -> m (Expression e f)) ->
Expression c d -> m (Expression c d)
compos ret app f v =
case v of
OpenTable i t -> ret (OpenTable i t)
OpenFile i s -> ret (OpenFile i s)
Map i g e -> ret (Map i g) `app` f e
WriteFile i s e -> ret (WriteFile i s) `app` f e
WriteTable i t e -> ret (WriteTable i t) `app` f e
LocalMerge i es -> ret (LocalMerge i) `app` mapm f es
where
mapm :: forall g h. (Expression g h -> m (Expression g h)) ->
[Expression g h] -> m [Expression g h]
mapm g = foldr (app . app (ret (:)) . g) (ret [])
Then, with this in hand, we get all the usual compos variants:
composOp :: (forall a b. Expression a b -> Expression a b) ->
Expression c d -> Expression c d
composOp f = runIdentity . composOpM (Identity . f)
composOpM :: (Monad m) => (forall a b. Expression a b -> m (Expression a
b)) -> Expression c d -> m (Expression c d)
composOpM = compos return ap
composOpM_ :: (Monad m) => (forall a b. Expression a b -> m ()) ->
Expression c d -> m ()
composOpM_ = composOpFold (return ()) (>>)
composOpFold :: b -> (b -> b -> b) -> (forall c d. Expression c d -> b)
-> Expression e f -> b
composOpFold z c f = unC . compos (\_ -> C z) (\(C x) (C y) -> C (c x
y)) (C . f)
newtype C b a = C { unC :: b }
See Bringert and Ranta's "A Pattern for Almost Compositional Functions"
for more details:
http://publications.lib.chalmers.se/records/fulltext/local_75172.pdf
In my experience, compos requires a little work, but it can handle just
about any data type or family of data types you throw at it.
(note the twist on compos is just an extra rank 2 type to quantify over
the "a" and "b" in "Expression a b". The same rank 2 type lets you write
the recursive code almost directly as well [using polymorphic recursion]
-- compos is just a nice generic way to avoid writing the boilerplate
traversal repeatedly).
Cheers,
Gershom
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20121120/8733fdf4/attachment.htm>
More information about the Haskell-Cafe
mailing list