updating labelled fields

Hal Daume III hdaume@ISI.EDU
Wed, 8 May 2002 09:22:17 -0700 (PDT)


I like this idea, but I think it will cause ambiguity in
parsing.  Consider:

blah = do {foo} ...

should foo be parsed as a statement list (under the assumption that the
open brace is instead of using layout) or as an assignment, as in:

blah = do {foo}
          x <- bar

(which probably wouldn't typecheck, but we don't know that at parsing.)  i
could be wrong and it might be able to be made work, but i'm not
convinced...

Another option that I believe would work, drawing from the deriving (Set
with "set") thing posted earlier, that I think may be better in the sense
that it doesn't confusing set/apply function naming with class
derivations, would be something like:

data T = T 
  { myString :: String with (Set as setMyString, Apply as apMyString),
    myInt    :: Int    with (Set as setMyInt),
    myBool   :: Bool   with (Apply as apMyBool) }

which would be the equivalent of defining "data T = T {myString::String,
myInt::Int,myBool::Bool}" and four functions: setMyString, apMyString,
setMyInt and apMyBool.  This allows you to specify exactly which functions
you want.  Perhaps even allow something like:

data T = T 
  { myString :: String with (Set,Apply),
    myInt    :: Int    with (Set),
    myBool   :: Bool   with (Apply) }

where the "default" names are used (i.e., Set for x is "set" + x with the
first letter capitalized).

This brings up one issue, namely, what to do with:

data T
 = T { a :: String with (Set),
       b :: Int }
 | U { a :: String with (Set,Apply),
       c :: Bool }

Personally, I don't think this should be disallowed and the definitions
should be:

setA b (T a _) = T a b
setA b (U a _) = U a b
apA f (U a b) = U a (f b)

How do people feel about something like this?  I've already implemented
the $= apply in my personal copy of ghc and it works fine (as witnessed by
-ddump-parsed); i think it required about 8 lines of code to be changed.

 - Hal

--
Hal Daume III

 "Computer science is no more about computers    | hdaume@isi.edu
  than astronomy is about telescopes." -Dijkstra | www.isi.edu/~hdaume

On Tue, 7 May 2002, Zdenek Dvorak wrote:

> Hello.
> 
> >DrIFT which i am now maintaining can derive such utility functions out
> >of the box. just add a {-!deriving: update -} to get update functions
> >for every labeled field in a datatype. quite useful, I have not updated
> >the web page yet, but the new DrIFT homepage will be at
> >
> >http://homer.netmar.com/~john/computer/haskell/DrIFT/
> 
> Nothing against DrIFT, but it requieres running preprocessing before real
> compilation; I don't like it for short programs, that I have defined just in
> one module and I'm debugging/modificating them.
> 
> I've thought about syntax for set/update functions some time ago too.
> What I though about is:
> 
> ({assignments}) desugars to \x->x{assignments}
> x{as, field =, bs} desugars to \y->x{as, field = y, bs}
> x{as, field, bs} desugars to \f->x{as, field = f (field x), bs}
> 
> Then set function would be just ({field =}) and apply ({field})
> (it does not need to create some artificial names for them that could
> colide with user names).
> 
> Not really sure it does not conflict with rest of syntax, though.
> 
> Zdenek Dvorak
> 
> > > Anyway I'd prefer to have some way to 'derive' apply and set functions.
> > > Something like
> > > > data MyData = MyData { foo :: fooType, bar :: ..., .... }
> > > >  deriving (Set, Apply)
> > >
> > > Using the keyword "deriving" would probably be a bad idea though :)
> > > The set and apply functions could be derived with a standard postfix or 
> >maybe
> > > prefix... fooAp or apFoo.
> > > Maybe we could introduce sintax to specify it...
> > > > deriving (Set with "set", Apply with "ap")
> > >
> > > I don't know... I'm just brainstorming right now.
> > > Having actual functions is important. I don't think I have to explain 
> >why to
> > > people in this mailing list :-)
> > >
> > > > Anyway, does such a thing exist, and, if not, is there any chance it 
> >could
> > > > exist, or is it just syntactic salt to too many people? :)
> > > I whish you better luck than I've had so far whenever making posts about 
> >this
> > > same issue ;)
> 
> _________________________________________________________________
> MSN Photos is the easiest way to share and print your photos: 
> http://photos.msn.com/support/worldwide.aspx
> 
> _______________________________________________
> Haskell mailing list
> Haskell@haskell.org
> http://www.haskell.org/mailman/listinfo/haskell
>