Re: the dreaded offside rule

2006-03-08 Thread Lennart Augustsson

I agree with it being complicated.  I don't know of any compiler
that implements it correctly.  Do you say your combinators do?

That said, I don't think it can be replaced easily without breaking
existing code, so I'm unwilling to change unless someone can show
an alternative that handles 99.9% of the existing code.

-- Lennart

Doaitse Swierstra wrote:
It is with some hesitation that I want to bring up another point, in 
which Haskell' could be an improvement above Haskell: the offside rule.


Although I manage to live with it, I encountered many problems with it 
in the past:


  1) it is impossible to explain the precise workings of the rule to a 
class of first years undergraduates


 This is extremely demotivating. I do not want to teach using the 
following utterances: "If you write your programs in the same style as I 
do on my slides, you will usually get away with it". Students are 
perfectly happy to accept that complicated things are complicated, but 
are not very willing to buy complicated explanations for things which 
ought to be simple. I furthermore think it is  waist of time to to have 
to go into this in my lectures. I do not think the alternative, in which 
you always have to write { ; ; } is an option. A language in which every 
let is followed by a { is plain stupid; just like in Pascal, where each 
procedure, function, const, var and begin keyword has to be preceded by 
a (thus superfluous) semicolon.


  2) it has created havoc among students for years, with Hugs 
complaining about improper semicolons, whereas
 the student has not typed a single semicolon in his program. many 
students think Haskell is a complicated language,
 mainly because of offside rules, (and the monomorphism restriction 
of course)


  3) it is formulated in an implementation oriented way, prohibiting 
proper tool support for parser generation


 With our parser combinator library we have created very efficient 
error-correcting parsers (far more efficient that Parsec based ones) for 
quite a few languages (including Haskell). Creating one for Haskell 
however became a nightmare, although we have managed to encapsulate the 
problem in a special offside parser combinator. Our parsers perform 
error-correction automatically, and this is simply not compatible with a 
prescription in the language definition as to how certain parse errors 
should be dealt with (especially that they are not errors). We had to 
put parser-brain-surgery into place in order to cope with the 
description of the offside rule. Although the problem is solved by the 
introduction of the offside combinator now, I think it is a sign of 
unhealthiness of the formulation, which is too implementation dependent.


  4) based on many examples my claim is that almost no Haskell 
programmer can always correctly apply to offside rule


We might go back to something simpler, like e.g. the Miranda(tm) rule, 
in which declarations have to start in the same column, and a 
declaration extends to the lower right of its first character.


 Doaitse Swierstra


___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime



___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


Re: small extension to `...` notation

2006-03-08 Thread Ben Rudiak-Gould

Philippa Cowderoy wrote:

On Wed, 8 Mar 2006, Doaitse Swierstra wrote:

 xs `zipWith (+)` ys


There is one problem with this: it doesn't nest [...]


Another problem is that it's not clear how to declare the fixity of these 
things. Should they always have the default fixity? Should they be required 
to have the form ` ` and use the fixity of `ident`? Neither 
approach seems very clean.


-- Ben

___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


Re: the dreaded offside rule

2006-03-08 Thread Neil Mitchell
Hi,

>1) it is impossible to explain the precise workings of the rule to
> a class of first years undergraduates

Then don't explain it to them. At York in the 3rd year Haskell course
it is never explained in detail, I think it might be briefly mentioned
in passing that some kind of indentation thing is used, but not
focused on. I certainly don't have a clue what the rule is.

I believe the Haskell rule is a superset of the Miranda (TM) one? If
so just explain the Miranda one.

I have a friend, who was programming Haskell for 3 years before he
even realised that the indentation had an effect on the program! And
not trivial stuff, he wrote a lot of big programs. If you just do
sensible indentation, then it just works (TM).

As for hugs complaining about semi-colons, thats just a bad error
message - not a reason for a language change.

Of course, your point about being overly complex is possibly true -
but I don't think its possible to reduce the complexity without
breaking existing programs, and I don't think its worth doing that.

The one thing about having the offside rule which bugs me is that some
people use tabs with 8 spaces (Haskell standard), others use 4 (me)
and others use variable other sizes. This makes code 100% incompatible
between different people. I would make it a warning to use a tab in a
Haskell source file.

Thanks

Neil
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


Re: the dreaded offside rule

2006-03-08 Thread Philippa Cowderoy
On Wed, 8 Mar 2006, Doaitse Swierstra wrote:

>   1) it is impossible to explain the precise workings of the rule to a class
> of first years undergraduates
> 
>  This is extremely demotivating. I do not want to teach using the
> following utterances: "If you write your programs in the same style as I do on
> my slides, you will usually get away with it". Students are perfectly happy to
> accept that complicated things are complicated, but are not very willing to
> buy complicated explanations for things which ought to be simple. I
> furthermore think it is  waist of time to to have to go into this in my
> lectures. I do not think the alternative, in which you always have to write {
> ; ; } is an option. A language in which every let is followed by a { is plain
> stupid; just like in Pascal, where each procedure, function, const, var and
> begin keyword has to be preceded by a (thus superfluous) semicolon.
> 

I found the layout rule trivial to understand the moment I knew about the 
braces-and-semicolons versions of the constructs and that the layout rule 
desugars to that with some simple rules. After that it was just a matter 
of remembering where the braces are on which constructs.

I can see it might be a little harder explaining it to a class who haven't 
seen a braces-and-semicolons language before Haskell though.

-- 
[EMAIL PROTECTED]

'In Ankh-Morpork even the shit have a street to itself...
 Truly this is a land of opportunity.' - Detritus, Men at Arms
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


the dreaded offside rule

2006-03-08 Thread Doaitse Swierstra
It is with some hesitation that I want to bring up another point, in  
which Haskell' could be an improvement above Haskell: the offside rule.


Although I manage to live with it, I encountered many problems with  
it in the past:


  1) it is impossible to explain the precise workings of the rule to  
a class of first years undergraduates


 This is extremely demotivating. I do not want to teach using  
the following utterances: "If you write your programs in the same  
style as I do on my slides, you will usually get away with it".  
Students are perfectly happy to accept that complicated things are  
complicated, but are not very willing to buy complicated explanations  
for things which ought to be simple. I furthermore think it is  waist  
of time to to have to go into this in my lectures. I do not think the  
alternative, in which you always have to write { ; ; } is an option.  
A language in which every let is followed by a { is plain stupid;  
just like in Pascal, where each procedure, function, const, var and  
begin keyword has to be preceded by a (thus superfluous) semicolon.


  2) it has created havoc among students for years, with Hugs  
complaining about improper semicolons, whereas
 the student has not typed a single semicolon in his program.  
many students think Haskell is a complicated language,
 mainly because of offside rules, (and the monomorphism  
restriction of course)


  3) it is formulated in an implementation oriented way, prohibiting  
proper tool support for parser generation


 With our parser combinator library we have created very  
efficient error-correcting parsers (far more efficient that Parsec  
based ones) for quite a few languages (including Haskell). Creating  
one for Haskell however became a nightmare, although we have managed  
to encapsulate the problem in a special offside parser combinator.  
Our parsers perform error-correction automatically, and this is  
simply not compatible with a prescription in the language definition  
as to how certain parse errors should be dealt with (especially that  
they are not errors). We had to put parser-brain-surgery into place  
in order to cope with the description of the offside rule. Although  
the problem is solved by the introduction of the offside combinator  
now, I think it is a sign of unhealthiness of the formulation, which  
is too implementation dependent.


  4) based on many examples my claim is that almost no Haskell  
programmer can always correctly apply to offside rule


We might go back to something simpler, like e.g. the Miranda(tm)  
rule, in which declarations have to start in the same column, and a  
declaration extends to the lower right of its first character.


 Doaitse Swierstra


___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


Re: small extension to `...` notation

2006-03-08 Thread Philippa Cowderoy
On Wed, 8 Mar 2006, Doaitse Swierstra wrote:

> In Haskell we write `f` in order to infixify the identifier f. In ABC the
> stuff between backquotes is not limited to an identifier, but any expression
> may occur there. This would allow one to write e.g.
> 
>  xs `zipWith (+)` ys
> 
> In general   ``  => ()  
> 
> I think it is a small extension to Haskell, which does not break anything
> existing, and provides yet another opportunity to beautify one programs,
> especially in combination with programs like lhs2TeX.
> 

There is one problem with this: it doesn't nest, you can't tell an opening 
from a closing backquote, which can cause problems when transforming or 
rearranging code. Possibly `()` and the existing ``?

-- 
[EMAIL PROTECTED]

'In Ankh-Morpork even the shit have a street to itself...
 Truly this is a land of opportunity.' - Detritus, Men at Arms
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


small extension to `...` notation

2006-03-08 Thread Doaitse Swierstra
In Haskell we write `f` in order to infixify the identifier f. In ABC  
the stuff between backquotes is not limited to an identifier, but any  
expression may occur there. This would allow one to write e.g.


 xs `zipWith (+)` ys

In general   ``  => ()  

I think it is a small extension to Haskell, which does not break  
anything existing, and provides yet another opportunity to beautify  
one programs, especially in combination with programs like lhs2TeX.


 Doaitse Swierstra


___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


Re: If you really care, make sure it gets on the wiki (how to create a proposal)

2006-03-08 Thread Wolfgang Jeltsch
Am Sonntag, 5. März 2006 02:59 schrieb isaac jones:
> [...]

> 2. If you don't have a wiki account, Log in with username guest and password
> haskell' to create and edit tickets. 

How do I get a account for the wiki?

> [...]

Best wishes,
Wolfgang
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


Re: overlapping instances and constraints

2006-03-08 Thread Claus Reinke
there were a couple of issues Simon raised that I hadn't responded to in 
my earlier reply. since no-one else has taken them on so far, either, ..



- Haskell would need to be a lot more specific about exactly where
context reduction takes place.  Consider
f xs x = xs == [x]
Do we infer the type (Eq a) => [a] -> a -> Bool?  Thereby committing to
a particular choice of instance?  Or do we (as GHC does) infer the type
(Eq [a]) => [a] -> a -> Bool, so that if f is applied at (say) type
Char, then an instance Eq [Char] instance would apply.  GHC is careful
to do the latter.


my general idea about that would be never to commit unless we know it
is the only choice. which seems to be in line with what GHC is doing in
this case. of course, it follows that we'd like to be able to specify choices
unambiguously, to avoid delayed committs.


Concerning using the instance context, yes, it's attractive, but it
involves *search* which the current mechanism does not.  Presumably you
have in mind that the type system should "commit" only when there is
only one remaining instance declaration that can fit.  You need to be
very careful not to prune off search branches prematurely, because in a
traditional HM type checker you don't know what all the type are
completely.  And you need to take functional dependencies into account
during the search (but not irrevocably).   I have not implemented this
in GHC.  I don't know anyone who has.   I don't even know anyone who has
specified it.


search, yes, but with deterministic result (similar to HM inference). so 
the main issue is that we need to be able to perform inferences without 
committing to their conclusions, or setting up encapsulated inference 
processes with their own assumptions. which isn't surprising given that 
we're dealing with implications, or type class functions, where the usual 
proof rule is "if we can prove the conclusions assuming the prerequisites, 
then we have proven the implication". 

that may be substantially more complicated to implement, but is just what 
Prolog, or even simple HM type inference for functions, have been doing 
for a long time. and it is a pain to see the current situation, where Haskell 
implementations treat the conclusions as if there were no pre-requisites

(Haskell: these instances are overlapping; Programmer: no, they are not,
just look at the code!).

can we agree, at least in principle, that in the long term this needs to change?

since the general implementation techniques aren't exactly new, are there 
any specific reasons why they couldn't be applied to type classes? we'd
have a state for the constraint store, and a backtracking monad with 
deterministic result for the inference, just as we have for implementing 
HM inference. 

if we want a more efficient, more low-level implementation, we could 
use the WAM's idea of variable trails (proceed as if there was no 
search, but record all variable substitutions, so that we can undo them 
if it turns out that this branch fails). or is there a pragmatic issue with 
current implementations of those type classes, having grown out of 
simpler type class beginnings, and having grown so complex that they 
couldn't go in that direction without a major rewrite?


in the short term, I'd be quite willing to aim for a compromise, where
we'd not look at all constraints in the context, but just at a few specific 
ones, for which we know that the search involved will be very shallow.

whether to do that via strictness annotations in contexts, as Bulat has
suggested, or by reserving a separate syntactic position for constraints
known to have shallow proofs, is another question.

the outstanding example of this would be type inequalities, which I'd
really like to see in Haskell', because they remove a whole class of
instance overlaps. and with FDs, one can build on that foundation.

I'm not sure I have a good handle on understanding when or how searches
could be hampered by incomplete types. naively, I'd expect residuation, ie,
delaying partially instantiated constraints until their variables are specific
enough to proceed with inference. I think CHR already does this. 

if that means that instance context constraints cannot be completely 
resolved without looking at concrete uses of those instances, then 
we'd have a problem, but no more than at the moment. and I suspect

that problem will not be a showstopper. on the contrary, it may help
to keep those searches shallow.

from my experience, it seems quite possible to arrange instance 
contexts in such a way that even such incomplete resolution will be 
sufficient to show that they ensure mutual exclusion of their instances 
(type inequality, type-level conditional, FDs, closed classes, ..). 
which would be all that was needed at that point.


once we start looking, we could probably find more ways to help
such incomplete inferences along. eg, if there was a built-in class
Fail a (built-in only so that the system could know there can be
no i

Re: alternative translation of type classes to CHR (was:relaxedinstance rules spec)

2006-03-08 Thread Claus Reinke
a second oversight, in variation B: CHR rules are selected by matching, 
not by unification (which is quite essential to modelling the way type 
class inference works). this means that the idea of generating memo_

constraints for the instance fdis and relying on the clas fdi rules to
use that information is not going to work directly. 


however, we can look at the intended composition of those fdi instance
rules with the fdi class rules, and specialize the latter when applied to 
the rhs of the former (assuming unification while doing so).


!!
the nice thing about this is that variation B now looks very much like
the original translation, differing only in the splitting of roles, without
any other tricks merged in. that means it should now be more obvious
why variation B is a modification of the original translation with better
confluence properties. 

all confluence problems in the FD-CHR paper, as far as they were 
not due to instances inconsistent with the FDs, seem to be due to 
conflicts between improvement and inference rules. we restore 
confluence by splitting these two constraint roles, letting inference 
and improvements work on constraints in separate roles, thus 
removing the conflicts.


= Tc2CHR alternative, with separated roles

   class C => TC a1..an | fd1,..,fdm

   where fdi is of the form: ai1..aik -> ai0

   ->  TC a b <=> infer_TC a b, memo_TC a b, C. (two roles +superclasses)

   ->  memo_TC  a1..an, memo_TC th(b1)..th(bn) => ai0=bi0. (fdi)

where th(bij) | j>0 = aij
  th(bl)  | not (exists j>0. l==ij) = bl 


= Variation B (separate instance inference/FD improvement):

   instance C => TC t1..tn

   -> infer_TC t1..tn <=> C.   (instance inference)

   -> memo_TC th(b1)..th(bn) => ti0=bi0. (fdi instance improvement)

where th(bij) | j>0 = tij
  th(bl)  | not (exists j>0. l==ij) = bl 


=

in particular, the new CHRs for examples 14 and 18 (coverage violations,
hence not variable-restricted, hence confluence proof doesn't apply)
should now be confluent, because even after simplification, we can still use 
the class FDs for improvement.


here are the relevant rules for example 14:

   /* one constraint, two roles + superclasses */
   eval(Env,Exp,T) <=> infer_eval(Env,Exp,T), memo_eval(Env,Exp,T), true.

   /* functional dependencies */
   memo_eval(Env,Exp,T1), memo_eval(Env,Exp,T2) ==> T1=T2.

   /* instance inference: */
   infer_eval(Env,expAbs(X, Exp),to(V1, V2)) <=> eval(cons((X, V1), Env), Exp, 
V2).

   /* instance improvements: */
   memo_eval(Env_,Exp_,T_) ==> T_=to(V1, V2).

and the troublesome example constraints:

   eval(Env,expAbs(X,Exp),T1), eval(Env,expAbs(X,Exp),T2).
->
   infer_eval(Env,expAbs(X,Exp),T1), infer_eval(Env,expAbs(X,Exp),T2), 
   memo_eval(Env,expAbs(X,Exp),T1), memo_eval(Env,expAbs(X,Exp),T2).


[
-> [class FD first]
   infer_eval(Env,expAbs(X,Exp),T2), memo_eval(Env,expAbs(X,Exp),T2),
   T1=T2.
|
-> [instance improvement and simplification first]
   eval(cons((X,V11),Env),Exp,V12), eval(cons((X,V21),Env),Exp,V22), 
   memo_eval(Env,expAbs(X,Exp),T1), memo_eval(Env,expAbs(X,Exp),T2),

   T1=to(V11,V12), T2=to(V21,V22).
]

-> [rejoin inferences]
   eval(cons((X,V21),Env),Exp,V22), 
   memo_eval(Env,expAbs(X,Exp),T2),

   T1=T2, T2=to(V21,V22).
-> ..

cheers,
claus

ps I've only listed the updated variation B here, to limit confusion. if you 
   want the updated code and full text, you should be able to use


   darcs get http://www.cs.kent.ac.uk/~cr3/chr/

___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


Re: relaxed instance rules spec (was: the MPTC Dilemma (please solve))

2006-03-08 Thread Jim Apple
On 3/7/06, Ben Rudiak-Gould <[EMAIL PROTECTED]> wrote:
# John Meacham wrote:
# # Polymorphic recursion allows the construction of infinite types if I
# # understand what you mean.
#
# No, that's different. An infinite type can't be written in (legal) Haskell.

Though GHC with existentials allows something infinite looking (and
not just because I named it "Inf" :-)):

> {-# OPTIONS -fglasgow-exts #-}

> data Zero = Zero
> data Succ n = Succ n

> -- Error: infinite type!
> -- x = Succ x

> data Inf = forall n . Inf n
> y = Inf (Succ y)

Jim
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime


Re: partial application syntax

2006-03-08 Thread Dinko Tenev
http://haskell.galois.com/cgi-bin/haskell-prime/trac.cgi/wiki/FlexiblePartialApplication

On 3/7/06, Wolfgang Jeltsch <[EMAIL PROTECTED]> wrote:
> Hello,
>
> there was some proposal for introducing a special syntax where f x _ z or
> f x ? z means \y -> f x y z.  Is there some information on the Haskell' trac
> site about this?
>
> Best wishes,
> Wolfgang
> ___
> Haskell-prime mailing list
> Haskell-prime@haskell.org
> http://haskell.org/mailman/listinfo/haskell-prime
>


--

Cheers,
Dinko
___
Haskell-prime mailing list
Haskell-prime@haskell.org
http://haskell.org/mailman/listinfo/haskell-prime