Re: Happy and Macros (was Re: ANNOUNCE: Happy 1.10 released)

2001-05-10 Thread Thomas Johnsson


S. Alexander Jacobson writes:
 > I am not a parsing expert, but given the recent discussion on macros, I
 > have to ask: why use happy rather than monadic parsing?  Monadic parsing
 > allows you to avoid a whole additional language/compilation step and work
 > in Hugs (where you don't have a makefile).  What does Happy buy you here?

Happy and others like it generate an LR parser, which is a well-established
technology since the late 60's (Knuth): efficient, deterministic, and checks the 
grammar for you.
Parser combinators are usually nondeterministic ie backtracking (pre-Knuth!:-)
though Cleverly Disguised in Haskell Higher Order clothes
LR parsers gives you greated freedom in expressing the grammar, with the LR parser 
generator
leaning over your shoulder.
Grammars possible with parsing combinators are more constrained: cannot use left 
recursion,
order of rules matters, etc. On the other hand, one has the whole abstraction 
machinery 
of Haskell or whatever at hand for writing the grammar rules.

The analogy that comes to mind is statically typed languages vs runtime typed ones.

--Thomas
PS would be cool to try to marry the two approaches






___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell



Re: Inferring from context declarations

2001-02-21 Thread Thomas Johnsson


Lennart Augustsson writes:
 > > Simon Peyton Jones' comments about dictionary passing are a red herring,
 > > since they assume a particular form of compiler.  Various (MLj, MLton)
 > > ML compilers already inline out all polymorphism.
 > ML is a language where you can do this.  In Haskell it is not always
 > possible to eliminate all polymorphism (due to polymorphic recursion).

I'd like to see an example of this!
--Thomas

___
Haskell mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/haskell



Haskell equiv of ML-Lex/ML-Yacc ?

1997-11-24 Thread Thomas Johnsson


In my imminent compiler construction course I'll be using
Andrew Appel's book "Modern compiler implementation in ML",
which uses ML-Lex and ML-Yacc, which are a part of the 
SML/NJ distribution.

Now of course I'd like to encourage the use of Hugs/Haskell,
especially since many of the students knows Haskell (but not ML)
to begin with ...

Q: does anyone know if there's a port of this stuff to Haskell?
Note that I'm not after a nondeterministic SLR parser (Ratatosk),
or some such  For pedagogical reasons I'd lite the tools
to be as similar as possible to Yacc/Bison/ML-Yacc, etc.

-- Thomas Johnsson






Re: 1.3 cleanup: patterns in list comprehensions

1993-10-14 Thread Thomas Johnsson



>Currently, guarded patterns are not allowed i list comprensions.
>I see no reason for this restriction, so I propose that we 
>allow them.
> 
>For example, one cannot write
>[  | (a,b)|a==b <- blablabigexpression ]
>but one has to write
>[  | (a,b) <- blablabigexpression, a==b ]
> 
> 
> What is the advantage of this?

I find it more natural put the extra condition in conjunction
with the pattern. Here's a real world example, from the
LALR parser generator I'm currently writing:

   [ .. | . (lsy, l, s:r) <- [all_kernel_item_tab ! kno], isNonterm s ]

The pattern (lsy, l, s:r) is *already* acting as a filter since s:r is
refutable, and isNonterm s is just one more condition. It seems rather
arbitrary that one bit of the filtering can be done in the pattern but
another, the boolean condition, can't. It would thus be more natural to say

   [ .. | . (lsy, l, s:r)|isNonterm s <- [all_kernel_item_tab ! kno] ]

(which is actually what I did, which is how I discovered what I consider
as a bug in the syntax).

AN ASIDE: Actually, in this example, what I *really* wanted was a 
definitional list comprension (Kevin, was that what you called it?
You wrote a note about this ages ago):
So that a qualifier can also be a let or where definition,
perhaps like:

   [ .. | . (lsy, l, s:r)|isNonterm s = all_kernel_item_tab ! kno ]

The problem with this syntax is that = looks too much like ==.

-- Thomas





1.3 cleanup: patterns in list comprehensions

1993-10-13 Thread Thomas Johnsson



Here's another little cleanup item:

Currently, guarded patterns are not allowed i list comprensions.
I see no reason for this restriction, so I propose that we 
allow them.

For example, one cannot write
[  | (a,b)|a==b <- blablabigexpression ]
but one has to write
[  | (a,b) <- blablabigexpression, a==b ]




-- Thomas




1.3 cleanup: symbol characters

1993-10-13 Thread Thomas Johnsson



I propose that we do the following cleanup in the lexical
syntax for operator symbols: 
Allow - and ~ inside operator symbols (and not just as first
characters in them).

Currently, e.g. -+ and ~= are allowed, but +- and =~  are not.
This seems a bit arbitrary to me.


-- Thomas




Re: Arrays and Assoc [ errata filterArray ]

1993-10-06 Thread Thomas Johnsson



Sorry, the definition of filterArray should read:


filterArray f z b list =
array b [ i := foldr f z [ x | j:=x <- list, i==j ] 
| i <- indices b 
]

-- Thomas






Re: Arrays and Assoc

1993-10-06 Thread Thomas Johnsson



> I agree, but I also agree with Lennart that both sorts of arrays are needed.

Yes, I agree on that; language design is, as always, a compromise
between the desirable semantics (in this case, as lazy as possible),
and desirable efficency, and we don't know yet how to make lazy arrays
a la LML arrays as (potentially) efficient as current Haskell accumArray.

So here is a concrete suggestion:

1) Keep accumarray as it is (but like foldr-like behaviour instead of 
   foldl).

2) Add one more function to the prelude (or a standard module,
   to be imported explicitly):

filterArray f z b list =
array b [ i := foldr f z [ x | j <- indices b, i==j ] 
| i <- indices b 
]

The only difference between assocArray and filterArray would be
that filterArray is lazy and ignores indices out of bound.


Another possibility would be to have only one, the lazy one,
and to use strictness annotations when the extra efficiency is desired;
but there seems to be a consensus against strictness annotations
(re the "newtype" discussion thread.)
But maybe the distaste is only for annotated *constructors* ?


-- Thomas






Re: re. Arrays and Assoc

1993-10-06 Thread Thomas Johnsson



> 
> Thomas Johnsson says:
> 
> >If I recall correctly, the := to be used in array comprehensions was a
> >consession to the FORTRAN/Id/Sisal community, so that array comprehensions
> >would look more like they were used to.
> 
> Both Arvind and I think this is notation is awful, and I don't recall
> either of us ASKING for it, so this was probably someone else's idea
> of a ``concession'' to the Id community!
> 
> Nikhil

Oh. My apologies to the Id community.
-- Thomas




Re: Arrays and Assoc

1993-10-06 Thread Thomas Johnsson



> >Let me just remind people what the LML arrays does:
> >
> >example:
> >lmlarray 1 3 f list = 
> >array [ 1:= f [ x | (1,x) <- list],
> >2:= f [ x | (2,x) <- list],
> >3:= f [ x | (3,x) <- list]
> >  ]
> >where array is like the ordinary Haskell array constructor function.
> > ...
> >It seems to me that it is a bit more general to apply f to the entire
> >list accumulated at each index, rather than as an operator for foldr.
> 
> If you want the list you can supply (:) and []. If not, you supply the
> operations, .[ ] 
> 
This is of course a matter of taste, but I think that in some cases it is a
bit clumsier:

lmlarray l u (take 2) list

does seem simpler than, say

amap (take 2) (lmlarray' l u (:) list).

(I don't know how to express  take 2  as an operator for foldr).
Also, in LML there is only one array constructor function, lmlarray
(simply called array in LML), so an 'ordinary' array is obtained by 

lmlarray l u (\[ x ].x) list

(LML has . instead of -> ).  Note that the pattern [ x ] in the function
forces the evaluation of the entire list and its indices, because,
intuitively, it has to be checked that there is no more than one element for
each index.

>  and the intermediate list never gets built.

Yes, there is that. 
-- Thomas





Re: Arrays and Assoc

1993-10-05 Thread Thomas Johnsson



John Launchbury says:
> 1. We should get rid of Assoc.
> 
> When explaining my programs to other people I find this is a point of
> confusion. Imagine exaplaining array construction, "When I define an array,
> the comprehension produces a list of index/value pairs, only they are not
> written as pairs--these's this special type called Assoc. Oh, and don't be
> confused by :=. That's not assignment. It is an infix pairing operator."
> All of this is entirely unnecessary. Pairs have been used in maths for
> decades to represent exactly this sort of thing. I simply do not believe
> that [Assoc a b] provides me with any better information than [(a,b)].
> Worse, I often find myself having to redefine standard pair functions on
> elements of Assoc.

I agree. 
If I recall correctly, the := to be used in array comprehensions was a
consession to the FORTRAN/Id/Sisal community, so that array comprehensions
would look more like they were used to.
But := is a bit unintuitive if you're thinking e.g. FORTRAN:
a = array[1 := 2, 2 := 4]
does *not* mean 1 is assigned to 2, etc!

But I think we can have the cake and eat it too, if we get rid of the
restriction (which I never liked) that operators beginning with : must be a
constructor: just define 
a := b = (a,b)

[ While I'm at it: we should also get rid of the lower/uppercase
restrictions on constructor/nonconstructor names.
]


> 2. Arrays should be lazier.
> 
> I'm expecting Lennart to agree with me here as LML has the Right Thing. I
> am convinced that there is no semantic problem with this, and I think that
> even Simon isn't horrified at the implementation implications. The ability
> to define arrays by self reference is just as important as it is for lists.

I'm not exactly sure what you mean here. It is allready possible to define 
arrays by self-reference in Haskell.

> I am assuming that the fact that lazy indexes provide a better match with
> laziness elsewhere is clear, but I am willing to expand on this point if
> someone wants.
> 
> 3. AccumArray should mimic foldr, not foldl.
> 
> This is tied up with the last point. The only advantage I can see with the
> present scheme would be if the array element could be used as the
> accumulator while the array was under construction. However, as arrays are
> non-strict in their *elements* this seems to be of no benefit. It seems to
> me highly sensible that the structure of the computation at each point
> should reflect the structure of the input sequence (i.e. the elements are
> in the same order). Furthermore, if a lazy operation is used (such as (:))
> then the result becomes available early (assuming point 2. above).
> 

Again I wholeheartedly agree. 
Let me just remind people what the LML arrays does:

example:
lmlarray 1 3 f list = 
array [ 1:= f [ x | (1,x) <- list],
2:= f [ x | (2,x) <- list],
3:= f [ x | (3,x) <- list]
  ]
where array is like the ordinary Haskell array constructor function.
In the implementation, the filtering needs to be done only once
and not n times, where n is the size of the array.
[ If anyone wants to know how this is done, I could expand on this. ]

It seems to me that it is a bit more general to apply f to the entire
list accumulated at each index, rather than as an operator for foldr.

-- Thomas







Invitation to visit the fp group at Chalmers

1992-11-23 Thread Thomas Johnsson





An Invitation to Visit the Functional Programming Group
===
at Chalmers University, Gothenburg
===

The functional programming group at Chalmers University of Technology
has funding to invite one or more medium-term visitors during the
coming year. Visits may be from three to twelve months duration, and
the visitor will be paid a tax-free fellowship of 12,000 SEK per
month, or your additional costs if you take a sabbatical to come.
Visits should preferably begin before the end of June 1993.  Visitors
must have a doctorate, and must be coming from outside Sweden to
be eligible for a fellowship.

The salary of 12,000 SEK per month is approximately US$22,000 or
UK#14,500 per year.  It is sufficient for one person to live
comfortably in Sweden.

The functional programming group consists of Lennart Augustsson, John
Hughes, Thomas Johnsson, Mikael Rittri, Mary Sheeran, and about a
dozen others. Current research includes:

*   Efficient implementation of lazy functional languages.
*   Parallel graph reduction.
*   Programming environments for functional languages, including 
window interfaces.
*   Garbage collection.
*   Program analysis by abstract interpretation.
*   Partial evaluation.
*   Relational programming and hardware algorithms.
*   Architectures to support functional languages.
*   User defined syntax.

If you are interested in visiting us, please contact John Hughes
([EMAIL PROTECTED]) or Thomas Johnsson ([EMAIL PROTECTED])
by 11 December.

-- John Hughes,  Thomas Johnsson







Invitation to visit the fp group at Chalmers

1992-11-23 Thread Thomas Johnsson



An Invitation to Visit the Functional Programming Group
===
at Chalmers University, Gothenburg
===

The functional programming group at Chalmers University of Technology
has funding to invite one or more medium-term visitors during the
coming year. Visits may be from three to twelve months duration, and
the visitor will be paid a tax-free fellowship of 12,000 SEK per
month, or your additional costs if you take a sabbatical to come.
Visits should preferably begin before the end of June 1993.  Visitors
must have a doctorate, and must be coming from outside Sweden to
be eligible for a fellowship.

The salary of 12,000 SEK per month is approximately US$22,000 or
UK#14,500 per year.  It is sufficient for one person to live
comfortably in Sweden.

The functional programming group consists of Lennart Augustsson, John
Hughes, Thomas Johnsson, Mikael Rittri, Mary Sheeran, and about a
dozen others. Current research includes:

*   Efficient implementation of lazy functional languages.
*   Parallel graph reduction.
*   Programming environments for functional languages, including 
window interfaces.
*   Garbage collection.
*   Program analysis by abstract interpretation.
*   Partial evaluation.
*   Relational programming and hardware algorithms.
*   Architectures to support functional languages.
*   User defined syntax.

If you are interested in visiting us, please contact John Hughes
([EMAIL PROTECTED]) or Thomas Johnsson ([EMAIL PROTECTED])
by 11 December.

-- John Hughes,  Thomas Johnsson