Re: [Haskell-cafe] Thoughts on program annotations.

2011-03-05 Thread wren ng thornton

On 3/4/11 2:32 PM, Jason Dusek wrote:

On Fri, Mar 4, 2011 at 07:01, wren ng thornton  wrote:

where the annotation of MergeAnn is merged with the previous
annotation up the tree (via mappend), thus allowing for
annotations to be inherited and modified incrementally based
on the Monoid instance; whereas the NewAnn constructor uses
the annotation directly, overriding any contextual
annotations. This can be helpful to reduce the amount of
duplication in the AST, though how helpful will depend on how
you plan to use/generate the ASTs.


   To handle this situation, I thought I'd leave it in the hands
   of the user (who will be me later) to use Data.Foldable.fold
   (or not) to arrive at the annotation when building up their
   tree of statements. I don't anticipate a problem with this but
   I may not use monoidal annotations on this AST for some time.
   (I anticipate using comments and raw text inclusions in the
   near future.)


That could be a workable solution. The tricky thing is that sometimes 
you want to mix the monoidal merge behavior of the annotation with the 
monoidal override behavior I mentioned, and it can get ugly to do that 
in one monoid. Whenever dealing with problems like this I often find 
myself running into semirings-- i.e., two monoids that interact in a 
sensible way. If you'll be wanting a semiring then the Foldable solution 
doesn't work very well. Again, it depends on what exactly you're 
planning to do with these ASTs.


--
Live well,
~wren

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Thoughts on program annotations.

2011-03-04 Thread Jason Dusek
On Fri, Mar 4, 2011 at 07:01, wren ng thornton  wrote:
> where the annotation of MergeAnn is merged with the previous
> annotation up the tree (via mappend), thus allowing for
> annotations to be inherited and modified incrementally based
> on the Monoid instance; whereas the NewAnn constructor uses
> the annotation directly, overriding any contextual
> annotations. This can be helpful to reduce the amount of
> duplication in the AST, though how helpful will depend on how
> you plan to use/generate the ASTs.

  To handle this situation, I thought I'd leave it in the hands
  of the user (who will be me later) to use Data.Foldable.fold
  (or not) to arrive at the annotation when building up their
  tree of statements. I don't anticipate a problem with this but
  I may not use monoidal annotations on this AST for some time.
  (I anticipate using comments and raw text inclusions in the
  near future.)

--
Jason Dusek
Linux User #510144 | http://counter.li.org/

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Thoughts on program annotations.

2011-03-04 Thread Stephen Tetley
There's also Martin Erwig's Parametric Fortran - which looks largely
similar but hides some of the parametric types with existentials.

Check the papers on his website, epscially the PADL one:

http://web.engr.oregonstate.edu/~erwig/papers/abstracts.html

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Thoughts on program annotations.

2011-03-03 Thread Max Bolingbroke
On 4 March 2011 06:32, Jason Dusek  wrote:
>    --  From 
> https://github.com/solidsnack/bash/blob/c718de36d349efc9ac073a2c7082742c45606769/hs/Language/Bash/Syntax.hs
>
>    data Annotated t = Annotated t (Statement t)
>    data Statement t = SimpleCommand Expression [Expression]
>                     | ...
>                     | IfThen (Annotated t) (Annotated t)
>                     | ...

I use this a variant of approach quite extensively and it works well
for me. My scheme is:

data Statement t = SimpleCommand Expression [Expression]
 | ...
 | IfThen (t (Statement t)) (t (Statement t))
 | ...

This is a slightly more efficient representation because it lets you
unpack the "t" field of your Annotated data constructor. For example,
what would in your system would be:

type MyStatement = Statement (Int, Int)

Would in my system be:

data Ann s = Ann Int Int s
type MyStatement = Statement Ann

i.e. instead of allocating both a Statement and a (,) at each level we
allocate just a Ann at each level.

In this system you will probably find it convenient to have a
typeclass inhabited by each possible annotation type:

class Copointed t where
  extract :: t a -> a

instance Copointed Ann where
  extract (Ann _ _ x) = x

Anyway, this is only a minor efficiency concern -- your scheme looks
solid to me as well.

Cheers,
Max

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


Re: [Haskell-cafe] Thoughts on program annotations.

2011-03-03 Thread wren ng thornton

On 3/4/11 1:32 AM, Jason Dusek wrote:

   Hi List,

   I am working on a Bash config generation system. I've decided
   to factor out the Bash AST and pretty printer, here in a
   pre-release state:

 https://github.com/solidsnack/bash


Awesome!


   Given that every statement has an annotation, it seemed better
   to me to use mutually recursive datatypes, using one datatype
   to capture "annotatedness", like this:

 --  From 
https://github.com/solidsnack/bash/blob/c718de36d349efc9ac073a2c7082742c45606769/hs/Language/Bash/Syntax.hs

 data Annotated t = Annotated t (Statement t)
 data Statement t = SimpleCommand Expression [Expression]
  | ...
  | IfThen (Annotated t) (Annotated t)
  | ...

   I wonder what folks think of this approach?


This is the same basic approach used by Tim Sheard:

http://web.cecs.pdx.edu/~sheard/papers/JfpPearl.ps
http://web.cecs.pdx.edu/~sheard/papers/generic.ps

and I think it works pretty well for this kind of problem. One change 
I'd make is to use something like this definition instead:


data Annotated a
= NewAnn   a (Statement a)
| MergeAnn a (Statement a)

where the annotation of MergeAnn is merged with the previous annotation 
up the tree (via mappend), thus allowing for annotations to be inherited 
and modified incrementally based on the Monoid instance; whereas the 
NewAnn constructor uses the annotation directly, overriding any 
contextual annotations. This can be helpful to reduce the amount of 
duplication in the AST, though how helpful will depend on how you plan 
to use/generate the ASTs.


--
Live well,
~wren

___
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe