ThreadId should be Eq and Ord!!!!!

1999-08-19 Thread George Russell

I asked for this months ago (it is after all documented) but nothing seems to have 
been done.
It is now extremely urgent that I sort this out if I want UniForM to work.  What am I 
to do??
Things are now sufficiently desperate that I will attempt to hack the GHC sources.



RE: ThreadId should be Eq and Ord!!!!!

1999-08-19 Thread Simon Peyton-Jones


 I asked for this months ago (it is after all documented) but 
 nothing seems to have been done.
 It is now extremely urgent that I sort this out if I want 
 UniForM to work.  What am I to do??
 Things are now sufficiently desperate that I will attempt to 
 hack the GHC sources.

George,

Try the module below.  It makes ThreadId an instance of Eq and Ord.

Simon


{-# OPTIONS -fglasgow-exts #-}

module Thread( cmpThread ) where

import PrelConc
import GlaExts

foreign import ccall "cmp_thread" unsafe cmp_thread :: Addr - Addr - Int
-- Returns -1, 0, 1

cmpThread :: ThreadId - ThreadId - Ordering
cmpThread (ThreadId t1) (ThreadId t2) 
  = case cmp_thread (unsafeCoerce# t1) (unsafeCoerce# t2) of
-1 - LT
0  - EQ
1  - GT

instance Eq ThreadId where
  t1 == t2 = case t1 `cmpThread` t2 of
EQ- True
other - False

instance Ord ThreadId where
  cmp = cmpThread



Re: Licenses and Libraries

1999-08-19 Thread Erik Meijer

 And, as a practical step, writing libraries seems like
 an excellent way to get involved --- especially if they're useable with
 multiple implementations.

I can reveal a little secret (Sigbjorn is far away in the Norwegian woods :-) namely 
that soon H/Direct will directly support .h files, which means that it will even be 
easier than before to get automate all the boring work in making standard C libraries 
available to Haskell. Just drag and drop it onto H/Direct and off you go. Hopefully 
this will convince the COM criticasters and MS sceptists that H/Direct is cool indeed.

Erik 






Re: List of class instances?

1999-08-19 Thread Marcin 'Qrczak' Kowalczyk

Thu, 19 Aug 1999 19:08:49 +1000, Fergus Henderson [EMAIL PROTECTED] pisze:

  The problem with this is that the caller of `biggest' needs to call
  `mkShape' on each element in the list before it can construct the list.
  Not _bad_, but rather unwieldy. The caller can't simply use `map' either
  if each element is of a different type.
  
  Anyone know of an elegant way to do this?
 
 I think that's the best you can do in standard Haskell.

One could define a specific polymorphic operator instead of : or [,,,]
to create such lists, so it would remove explicit `mkShape' calls.

-- 
 __("Marcin Kowalczyk * [EMAIL PROTECTED] http://kki.net.pl/qrczak/
 \__/  GCS/M d- s+:-- a22 C++$ UL++$ P+++ L++$ E-
  ^^W++ N+++ o? K? w(---) O? M- V? PS-- PE++ Y? PGP-+ t
QRCZAK  5? X- R tv-- b+++ DI D- G+ e h! r--%++ y-






Re: Licenses and Libraries

1999-08-19 Thread Erik Meijer


 Whatever happened to the auto-import of java classes?

That's what I am supposed to be working on while Sigbjorn is enjoying the fjords. We 
have a nasty bug having to do with the (what we thought as) clever way of representing 
JNI objects in Haskell. There is an elegant solution using implicit arguments, but 
alas that is only supported by Hugs :-)

So keep tuned,

Erik






Re: Adopted optional parameters solution.

1999-08-19 Thread Marko Schuetz

 "Marko" == Marko Schuetz [EMAIL PROTECTED] writes:

 "Andy" == Andy Gill [EMAIL PROTECTED] writes:
Andy instance (HTML a) = HTML ([HtmlAttr] - a) where
Andy html f = html (f [])

Marko Wouldn't 

 instance (HTML b, MonadPlus a) = HTML (a - b) where
 html f = html (f mzero)

Make that 

 instance (HTML b, MonadPlus m) = HTML (m a - b) where
 html f = html (f mzero)

Marko work as well?

Marko
-- 
Marko Schütz[EMAIL PROTECTED]
http://www.ki.informatik.uni-frankfurt.de/~marko/





propaganda 3: Advaced Functional Programming 3 Proceedings

1999-08-19 Thread S. Doaitse Swierstra

colorparam,,/parambiggerAFP3 Proceedings


/bigger/colorYou may not have noticed, but Springer has published
the proceedings of the AFP3:


colorparam,,/param@book{AFP3,

   author= {Doaitse Swierstra and Pedro Henriques and Jos\'{e}
Oliveira},

   title = {Advanced Functional Programming, Third International
School, AFP'98},

   publisher = {Springer},

   year  = {1999},

   isbn  = {9 783540 662419},

   series= {LNCS},

   number= {1608}

}


/colorI quote from the preface:


In this volume you will find the lecture notes corresponding to the 

presentations given at the 3rd summer school on 

Advanced Functional Programming, held in Braga, Portugal from 

September 12--19, 1998.


This school was preceded by earlier instances in Bastad (1995, Sweden,
LNCS 

925) and Portland (1996, USA, LNCS 1110).  The goal of this series of
schools is 

to bring recent developments in the area of functional programming to 

a large group of students.  The notes are published in order to enable


individuals, small study groups, and lecturers to become acquainted 

with recent work in the fast developing area of functional
programming.


What makes this instance of the school particularly interesting is 

that all lectures introduced useful software, that was used by the 

students in the classes to get hands-on experience with the subjects 

taught.  We urge readers of this volume to download the latest version
of this 

software from the Internet and try to do the exercises from the 

text themselves; the proof of the program is in the typing.


The first lecture, on  colorparam,,/paramSorting
Morphisms/color, serves as a gentle 

introduction to the things to come.  If you have always been afraid of


the word ``morphism'', and you have been wondering what catamorphisms,


anamorphisms, hylomorphims and paramorphims were about, this is the 

paper to read first; you will discover that they are merely names for 

recursion patterns that occur over and over again when writing
functional 

programs.  The algorithms in the paper are all about sorting, and
since


you are likely to know those algorithms by heart already, seeing 

them structured and analyzed in a novel way should serve as a
motivation to 

read on with the second lecture.


The second lecture, on colorparam,,/paramGeneric
Programming/color, is almost a book in a 

book.  The notes can be seen as the culminating point of the 

STOP-project, that was sponsored by the Dutch government at the end of


the 80's and the beginning of the 90's; its overall goal was the 

development of a calculational way of deriving programs.  The project 

has provided deeper insight into real functional programming

and into the theory behind many things commonly written by functional

programmers.  One of the main achievements of the project has been

to make people aware of the fact that many algorithms can be described


in a data-independent way.  The PolyP system introduced in these notes


is one of the translations to the Haskell-world of this theoretical 

underpinning.


The third lecture, on colorparam,,/paramGeneric
Program Transformation/color, can also 

be seen as an application of the theory introduced in lecture two.  

Many efficiency-improving program transformations can be 

performed in a mechanical way, and these would not have been possible
without

insight into the correctness of such transformations gained in the 

lecture on Generic Programming.


The fourth lecture, on colorparam,,/paramDesigning
and Implementing Combinator 

Languages/color, introduces an easy to write formalism for writing
down the 

catamorphisms introduced in earlier chapters.  It is shown how quite 

complicated catamorphisms, that at first sight seem rather forbidding 

by making extensive use of higher order domains, can actually be 

developed in a step-wise fashion, using an attribute grammar view; it 

is furthermore shown how to relate this way of programming with 

concepts from the object-oriented world thus making clear what the 

strengths and weaknesses of each world are.


The fifth lecture, titled colorparam,,/paramUsing
MetaML: a Staged Programming 

Language/color, introduces the concept of partial evaluation; it
serves as 

another instance of the quest for ``the most generic of writing 

programs without having to pay too much''.  The staging techniques 

show how costs that were introduced by adding extra levels of 

abstraction, may be moved from run-time to compile-time.


It has been common knowledge to users of modern functional languages 

that the type system can be a great help in shortening programs and 

reducing errors.  In the extreme one might see a type as a predicate 

capturing the properties of any expression with that type.  In the 

sixth lecture on colorparam,,/paramCayenne -- Spice
up your Programming with 

Dependent 

Re: List of class instances?

1999-08-19 Thread Fergus Henderson

On 18-Aug-1999, Michael Hobbs [EMAIL PROTECTED] wrote:
 What I would like to do is have a function that takes a list of
 "objects", where the objects are all instances of a particular class,
 but not necessarily the same type. Example:
 
 class Shape a where
   extent :: a - Point
   ...
 biggest :: Shape a = [a] - Point
 biggest listOfShapes = ...
 
 The closest I could come to achieving this in standard Haskell is:
 
 data Shape = Shape {extent :: Point, ...}
 class ShapeClass a where
   mkShape :: a - Shape
 biggest :: [Shape] - Point
 biggest listOfShapes = ...
 
 The problem with this is that the caller of `biggest' needs to call
 `mkShape' on each element in the list before it can construct the list.
 Not _bad_, but rather unwieldy. The caller can't simply use `map' either
 if each element is of a different type.
 
 Anyone know of an elegant way to do this?

I think that's the best you can do in standard Haskell.

 I'd prefer to stay away from
 compiler-specific features, but if something like existential types is
 just what I need, I guess I can bite the bullet.

Existential types are indeed designed for exactly this kind of circumstance.
However, existential types do not remove the need to call a function such as
`mkShape' to convert every element of the list into a single common type.
They just allow you to avoid converting your type-class `Shape' into a record.

Here's what it would look like with existential types.

-- class Shape is unchanged from your original example
class Shape a where
  extent :: a - Point
  ...

-- here we define an existential type that can hold any type of shape
data AnyShape = Shape a = mkAnyShape a

-- here we make the type AnyShape an instance of the class Shape,
-- by just unwrapping the `mkAnyShape' constructor and forwarding
-- the method calls
instance Shape AnyShape where
extent (mkAnyShape a) = extent a
...

-- the code for biggest is unchanged from your original example
biggest :: [AnyShape] - Point
biggest listOfShapes = ...

If you want you can delete all the occurrences of `Any' above,
overloading `Shape' as both a type name and a class name.

Note that the `data' and `instance' definitions in this example are
boiler-plate code.  I've previously suggested here that for single-parameter
type classes the compiler could generate such definitions automatically.
However, this suggestion did not meet with universal acceptance;
none of the current implementations of existential type classes
do anything along those lines.

-- 
Fergus Henderson [EMAIL PROTECTED]  |  "I have always known that the pursuit
WWW: http://www.cs.mu.oz.au/~fjh  |  of excellence is a lethal habit"
PGP: finger [EMAIL PROTECTED]| -- the last words of T. S. Garp.





Re: Question

1999-08-19 Thread Marcin 'Qrczak' Kowalczyk

Fri, 20 Aug 1999 02:59:09 +1000, Bob Howard [EMAIL PROTECTED] pisze:

 data BTree Integer = Leaf Integer | Node Integer (BTree Integer) (BTree Integer)

Write either
  data BTree a = Leaf a | Node a (BTree a) (BTree a)
or
  data BTree = Leaf Integer | Node Integer BTree BTree
depending on what you mean. Your version is not equivalent to the
first one because type variables (in contrast to concrete types)
must begin with lowercase. And is not equivalent to the second one
because an identifier must be a single word :-)

-- 
 __("Marcin Kowalczyk * [EMAIL PROTECTED] http://kki.net.pl/qrczak/
 \__/  GCS/M d- s+:-- a22 C++$ UL++$ P+++ L++$ E-
  ^^W++ N+++ o? K? w(---) O? M- V? PS-- PE++ Y? PGP-+ t
QRCZAK  5? X- R tv-- b+++ DI D- G+ e h! r--%++ y-






RE: Question

1999-08-19 Thread Mark P Jones

| Actually, I have fond memories of Algol compilers that gave error
| messages pretty much as comprehensible as those above.  I guess the
| problem is that Haskell compilers are prepared by people who have more
| pressing tasks than repeating old work on user friendly error messages
| :-(

Jon's comments bring up an issue that's been on my mind
for some time now.  Although this isn't a direct reply
to Jon's message, I think it might still be a good time
to raise the topic.

One of the greatest disappointments to date of the move
to more liberal (i.e. free software) licenses for systems
like Hugs and GHC, is that it has done almost nothing to
stimulate contributions to the implementations themselves
from outside the immediate (and small) group of developers
concerned.  Compare this, for example, with the Linux
community where the number of external contributors is
often cited as one of the benefits of the development
model used there.  Of course, it may just be the size
of our community, and the subject area: there's a much
greater demand for operating systems than there is for
lazy functional language implementations, and there are
probably a lot more people with expertise in the former
than there are in the latter.  And we shouldn't discount
or forget the valuable contributions that quite a lot
of people already make to Haskell in other ways, by
answering questions on this or related lists, by using
Haskell to build interesting applications, and so on.
What I'd like to do is to stimulate more in the way of
contributions to the implementations.

So perhaps we should be more explicit: I'm sure that all of
us involved in developing Haskell systems would welcome
contributions from the community that will help to make the
tools better.  Better tools will benefit the whole community,
and will make them accessible and useful to a much wider
audience.

This doesn't mean that people shouldn't post bug reports
or gripes about the systems --- the poster may not know
how to fix the problems, but perhaps their message will
inspire somebody else to tackle it.  But I do think that
we need to move away from a "them and us"/"developer and user"
picture, and towards a more community oriented "us".

All the best,
Mark






seek help with overlapping instances

1999-08-19 Thread Marko Schuetz

I have something similar to 

 class (Eq a) = Substitutable a where
  match :: a - a - Maybe (Substitution a)
  applySubst :: Substitution a - a - a

and two Types Type1, Type2, both of which are instances of class
Substitutable. In some places there is a sigma :: Substitution Type1
(or a phi :: Substitution Type2) to be applied to list :: [(Type1,
Type2)].

Now, something like 

 map (\(x, y) - (applySubst sigma x, y)) list

or 

 [(applySubst sigma x, y) | (x,y) - list]

is used (accordingly for phi). What I would prefer

 map (applySubst sigma) list

or

 map (applySubst phi) list

but defining

 instance Substitutable a = Substitutable (a,b) where
   applySubst sigma (x,y) = (applySubst sigma x, y)
 instance Substitutable b = Substitutable (a,b) where
   applySubst phi (x,y) = (x, applySubst phi y)

obviously has an overlapping instance (which will never occur).

I would greatly appreciate any suggestions on how handle this
situation.

Marko

-- 
Marko Schütz[EMAIL PROTECTED]
http://www.ki.informatik.uni-frankfurt.de/~marko/





RE: Question

1999-08-19 Thread Jan Skibinski



On Thu, 19 Aug 1999, S. Alexander Jacobson wrote:

 Mark,
 
 Out of curiosity, how big is the user community?  How many downloads of
 the software?  How many are on this list?  If you figure that 1 user in
 1000 is actually going to contribute a useful change each month (that is
 probably optimistic), the slow flow of changes isn't that surprising.  

Good question; I am also curious about it. I presume that Haskell
has reached a point of maturity and popularity where such
answers could be made public in a sense of a positive propaganda.
 
 Also, why are there so many Haskell compilers for so few users?
 There is really only one PD C compiler, GCC, and only one PD Perl
 interpreter, perl (or vice versa on the capitalization).
 Haskell has Hugs, GHC, NHC, HBC, for the core language, plus
 there are derivatives like cayenne, clean, mercury, etc.
 The variety of implemetations probably fragments the user community
 excessively further inhibiting growth.

Because of egos involved, because of a friendly competition,
because of personal decisions to include some experimental
features here and there, because of the fact that Haskell
evolves and is used as a research platform. I do not see
anything wrong with that.

Few years back there were three Eiffel compilers (Tower
Eiffel, ISE Eiffell, and a German one (I do not remember
its name, sorry)). Now there is also a Little Eiffel (or
something of this name).

The user base was probably as small as the Haskell's one today,
and Eiffel was less research oriented that Haskell is. But they
all tried to implement the same specification of the language,
support the same libraries, and the implementors were (are?) 
making their decisions together about future of Eiffel via NICE
(Non-profit International Consortium for Eiffel). Same pattern!

 The rewards for fixing stuff in haskell implementations are further
 reduced because compilers don't feel all that modular and because changes
 to the typesystem can obsolete large classes of fixes (especially to the
 error reporting system).  

Painful, but better than carrying some luggage of old ideas
that have not been proven workable, or easy to use.

What counts is a generalization but yet a simplification of
the language itself. Personally, I like simple and clear
theories, which I can then use to built possibly clever and
complex (as hell :-(, :=)) applications.

 
 On Thu, 19 Aug 1999, Mark P Jones wrote:

  Of course, it may just be the size
  of our community, and the subject area: there's a much
  greater demand for operating systems than there is for
  lazy functional language implementations, and there are
  probably a lot more people with expertise in the former
  than there are in the latter.  

Make Haskell simple, document it well in a fashion
understandable by a Joe programmer, and the tools will
start popping up. :-)

My point is that even a "Gentle introduction"
is not so gentle - as it is even admitted on www.haskell.org
pages. I started appreciated it long after my first
exposure to Haskell.

There are too many assumptions about the level of
a reader's comprehension of the texts presented.

Have you ever thought about the official definition
of Haskell in the introduction to Haskell Report,
or in its presentation in FAQ of comp.lang.functional?
It sounds like mumbo-jumbo, because all the terms
used there are foreign to Joe Programmer. That does
not mean that those terms are too damn difficult - they
are just simply not defined clearly up front.
 
Examples? What does it mean "first-class?" "Definition"
as opposed to "declaration?" "Denotational semantics?"
Where does a syntax ends and semantics takes over?
"Partial function" vs. "partial application"?
"Abstract data type" vs. "Algebraic data type"
vs. "Abstract syntax tree"? All are being abbreviated as AST!
What on earth is "lifting"?

I am not trying to be negative. As a matter of fact I am
currently working hard on getting those definitions in some,
hopefully logical, perspective - with some clear relashionship
amongst them. If I succeed I will publish it on line for a benefit
of the Joe Programmer.

 And we shouldn't discount
  or forget the valuable contributions that quite a lot
  of people already make to Haskell in other ways, by
  answering questions on this or related lists, by using
  Haskell to build interesting applications, and so on.
  What I'd like to do is to stimulate more in the way of
  contributions to the implementations.

My old topic, unfortunatelly ignored: make a sort
of database of Frequently 

RE: Question

1999-08-19 Thread S. Alexander Jacobson

Mark,

Out of curiosity, how big is the user community?  How many downloads of
the software?  How many are on this list?  If you figure that 1 user in
1000 is actually going to contribute a useful change each month (that is
probably optimistic), the slow flow of changes isn't that surprising.  

Also, why are there so many Haskell compilers for so few users?
There is really only one PD C compiler, GCC, and only one PD Perl
interpreter, perl (or vice versa on the capitalization).
Haskell has Hugs, GHC, NHC, HBC, for the core language, plus
there are derivatives like cayenne, clean, mercury, etc.
The variety of implemetations probably fragments the user community
excessively further inhibiting growth.

As far as fixing error messages go, it is hard for users to do that
because they don't know enough about where the type system is going.
My guess is that there is a big tradeoff between powerful type systems and
clear error messages.  Didn't Haskell98 eliminate monad comprehensions
and give lists a special syntax so beginners could understand error
messages. (To me, this seems like a step in the wrong direction)

The rewards for fixing stuff in haskell implementations are further
reduced because compilers don't feel all that modular and because changes
to the typesystem can obsolete large classes of fixes (especially to the
error reporting system).  

For example, if Haskell moves to a Categorical Prelude with Arrows as a
library interface standard and extensible records, users will be
interacting much less with the language and much more with generic library
interfaces.  In that context users will rarely use Data statements
or raw constructors and work involved with cleaning up those error
messages becomes less useful (I assume the language developers know this
as well and that is why they are not putting effort into the error message
side of things).

As an aside, the cost of this very powerful type system will probably be
error messages that are probably incomprehsible to those not versed in
category theory (I think the cost is worth it, C++ and Java has similar
issues with OO theory).

-Alex-

___
S. Alexander Jacobson   Shop.Com
1-212-697-0184 voiceThe Easiest Way To Shop


On Thu, 19 Aug 1999, Mark P Jones wrote:

 | Actually, I have fond memories of Algol compilers that gave error
 | messages pretty much as comprehensible as those above.  I guess the
 | problem is that Haskell compilers are prepared by people who have more
 | pressing tasks than repeating old work on user friendly error messages
 | :-(
 
 Jon's comments bring up an issue that's been on my mind
 for some time now.  Although this isn't a direct reply
 to Jon's message, I think it might still be a good time
 to raise the topic.
 
 One of the greatest disappointments to date of the move
 to more liberal (i.e. free software) licenses for systems
 like Hugs and GHC, is that it has done almost nothing to
 stimulate contributions to the implementations themselves
 from outside the immediate (and small) group of developers
 concerned.  Compare this, for example, with the Linux
 community where the number of external contributors is
 often cited as one of the benefits of the development
 model used there.  Of course, it may just be the size
 of our community, and the subject area: there's a much
 greater demand for operating systems than there is for
 lazy functional language implementations, and there are
 probably a lot more people with expertise in the former
 than there are in the latter.  And we shouldn't discount
 or forget the valuable contributions that quite a lot
 of people already make to Haskell in other ways, by
 answering questions on this or related lists, by using
 Haskell to build interesting applications, and so on.
 What I'd like to do is to stimulate more in the way of
 contributions to the implementations.
 
 So perhaps we should be more explicit: I'm sure that all of
 us involved in developing Haskell systems would welcome
 contributions from the community that will help to make the
 tools better.  Better tools will benefit the whole community,
 and will make them accessible and useful to a much wider
 audience.
 
 This doesn't mean that people shouldn't post bug reports
 or gripes about the systems --- the poster may not know
 how to fix the problems, but perhaps their message will
 inspire somebody else to tackle it.  But I do think that
 we need to move away from a "them and us"/"developer and user"
 picture, and towards a more community oriented "us".
 
 All the best,
 Mark
 








Haskell compiler not in Haskell?

1999-08-19 Thread S.D.Mechveliani

Do the Haskell compilers contain the parts written not in Haskell?

--
Sergey Mechveliani
[EMAIL PROTECTED]






RE: Question

1999-08-19 Thread Mark P Jones

| Ok my last post was a bit of a silly question on my behalf, but this
| has be stumped.
|  
| data BTree Integer = Leaf Integer | Node Integer (BTree Integer) (BTree Integer)
| ...
| can anyone tell me why I get this error when I compile this.
| ERROR "Btree.hs" (line 2): Illegal left hand side in datatype definition

Yes.  The parameters in a datatype definition are supposed to be type
variables, not type constants like Integer.  If you only need BTrees
with Integer values in them, then you don't need a parameter --- use:

  data BTree = Leaf Integer | Node Integer BTree BTree

and then mkTree will be a function of type Integer - BTree.

If you want a parameter, use:

  data BTree a = Leaf a | Node a (BTree a) (BTree a)

and then mkTree will be a function of type Integer - BTree Integer.
(or Num a = a - BTree a, in its most general form.)

All the best,
Mark






Re: syntax

1999-08-19 Thread D. Tweed

On Fri, 20 Aug 1999, Bob Howard wrote:

 data Tree a = Leaf a | Branch (Tree a) (Tree a)
 Branch :: Tree a - Tree a - Tree a
 Leaf :: a - Tree a
 
 Im just learning haskell and I cant seem to figure out what is wrong with the above 
code.
 Im using Hugs98 as in interperator (sp) and I keep getting the following Error when 
I read the file.
 
 ERROR "Tree.hs" (line 2): Syntax error in declaration (unexpected `::')

In haskell there's a policy that functions and bindings (the x in f x
=...) must begin with a lowercase letter whilst type names (Tree) and
constructors (Branch) must begin with capital letters.

Your Branch there is a function and hence needs to be called branch.

(Although the error message is bewildering if you don't know what's going
on, the :: is the first place an error is detected because it's also legal
in Haskell to define infix operators, so your line 2 is initially
interpreted as the start of something like

Branch x +o+ Branch y = 

)

___cheers,_dave__
email: [EMAIL PROTECTED]   "He'd stay up all night inventing an
www.cs.bris.ac.uk/~tweed/pi.htm   alarm clock to ensure he woke early
work tel: (0117) 954-5253 the next morning"-- Terry Pratchett






Re: Question

1999-08-19 Thread Michael Hobbs

 Bob Howard wrote:
 
 Ok my last post was a bit of a silly question on my behalf, but this
 has be stumped.
 
 data BTree Integer = Leaf Integer | Node Integer (BTree Integer)
 (BTree Integer)
 mkTree :: Integer - BTree
 mkTree 0 = Leaf 0
 mkTree int = Node int (mkTree (int - 1)) (mkTree (int -1))
 
 Forgetting anyother problems that may be in this code, can anyone tell
 me why I get this error when I compile this.
 ERROR "Btree.hs" (line 2): Illegal left hand side in datatype
 definition
 Bob

The "data BTree Integer" is not syntactically correct. The format is
like "data TypeName polyVar1 polyVar2 ... polyVarN = ...", where
polyVar is a polymorphic type variable. Type variables must start with a
lower-case letter. I suspect that what you eventually want is something
like this:

data BTree a = Leaf a | Node a (BTree a)

However, just to get things working, you can remove the type variable
and use:

data BTree = Leaf Integer | Node Integer (BTree Integer)

- Michael Hobbs





Re: Question

1999-08-19 Thread Paul Hudak

 Ok my last post was a bit of a silly question on my behalf, but this
 has be stumped.
 
 data BTree Integer 
  = Leaf Integer | Node Integer (BTree Integer) (BTree Integer)
 mkTree :: Integer - BTree
 mkTree 0 = Leaf 0
 mkTree int = Node int (mkTree (int - 1)) (mkTree (int -1))
 
 Forgetting anyother problems that may be in this code, can anyone tell
 me why I get this error when I compile this.
 ERROR "Btree.hs" (line 2): Illegal left hand side in datatype
 definition

If you want the BTree to contain only Integers, then just write:

 data BTree 
  = Leaf Integer | Node Integer (BTree Integer) (BTree Integer)
 mkTree :: Integer - BTree

If you want it to be polymorphic, then write:

 data BTree a
  = Leaf a | Node a (BTree a) (BTree a)
 mkTree :: Integer - BTree Integer

You could also make mkTree polymorphic, but because you are doing
arithmetic on the argument, the type must be constrained to be a member
of the Num class, in which case you would write:

 mkTree :: Num a = a - BTree a

  -Paul





Re: Question

1999-08-19 Thread Jon . Fairbairn

On 20 Aug, Bob Howard wrote:

  data BTree Integer = Leaf Integer | Node Integer (BTree Integer) (BTree Integer)
  ^
  this ought to be a type variable name, but you've put the
  name of a type.

  mkTree :: Integer - BTree
  ^ argument missing
  mkTree 0 = Leaf 0
  mkTree int = Node int (mkTree (int - 1)) (mkTree (int -1))

Actually, I have fond memories of Algol compilers that gave error
messages pretty much as comprehensible as those above.  I guess the
problem is that Haskell compilers are prepared by people who have more
pressing tasks than repeating old work on user friendly error messages
:-(

  Jón

-- 
Jón Fairbairn [EMAIL PROTECTED]







RE: Question

1999-08-19 Thread Mark P Jones

Hi Alex,

| Out of curiosity, how big is the user community?  How many downloads of
| the software?  How many are on this list?

I don't know the answers to any of these, but I think you're implying
"very small", and I'm sure you're right.  Perhaps you're also suggesting
that our community is too small for this kind of development model, and
again that may well be true.  What does this say about the future of
Haskell?

| Also, why are there so many Haskell compilers for so few users?
| There is really only one PD C compiler, GCC, and only one PD Perl
| interpreter, perl (or vice versa on the capitalization).
| Haskell has Hugs, GHC, NHC, HBC, for the core language ...

I think there are plenty of counterexamples here.  For example, we don't
just have Linux ... there's also NetBSD, FreeBSD, and GNU Hurd.  And for
C compilers, we also have egcs and lcc.  And there are several Java
compilers out there, both free and commercial.  But you're right again:
I'm sure that we fragment our small community to some degree by having
multiple implementations, perhaps without achieving critical mass.  One
positive effect of having multiple implementations is that it reduces
the element of risk: If Haskell was the product of one small group,
perhaps without clear funding or long term commitment to maintaining
it, then you'd probably have a harder time justifying any decision to
use it in a new project.  On the other hand, the differences between
implementations can also work against us.  The groups involved have been
actively working together to avoid such problems, but it's not easy.

| As an aside, the cost of this very powerful type system will probably be
| error messages that are probably incomprehsible to those not versed in
| category theory ...

I don't think that's a foregone conclusion.  Also, this is one of the
few areas in current Haskell systems where the developers can actually
justify the effort involved because it raises genuine and interesting
questions for research.  But note that the error messages that prompted
Jon's comment didn't have anything to do with sophisticated type systems.
Dealing with those kinds of things requires some hard work, but it isn't
research, and so it's hard to justify, at least in an academic context.

All the best,
Mark