From graemeturner@blueyonder.co.uk Tue Oct 10 19:11:14 2000 Date: Tue, 10 Oct 2000 19:11:14 +0100 From: Graeme Turner graemeturner@blueyonder.co.uk Subject: Haskell Problem
Hello,

I am e-mailing you to see if you could offer me a bit of assistance. I have
chosen to use
Haskell in a minor assignment at my University, Heriot Watt in Edinburgh.
The basic aim is to read in a file of data, sort it and then display it.

I have managed to get a sort to function properly but I am having trouble
with reading in the data from the file. I have managed to use the
hGetContents and hGetLine methods of the IO library to read the data in but
when it is read in, it is stored as an IO String type.

I would like to convert the input from the file into one large string so I
can process it before sorting it.

After reading the whole file into a variable, how do I then convert that IO
String to a String?

I would be very grateful if you could offer me some assistance in this
matter.

Thanks

Graeme Turner





From romildo@urano.iceb.ufop.br Tue Oct 10 18:49:59 2000 Date: Tue, 10 Oct 2000 15:49:59 -0200 From: =?iso-8859-1?Q?Jos=E9_Romildo_Malaquias?= romildo@urano.iceb.ufop.br Subject: Haskell Problem
On Tue, Oct 10, 2000 at 07:11:14PM +0100, Graeme Turner wrote:
> The basic aim is to read in a file of data, sort it and then display it.
> 
> I have managed to get a sort to function properly but I am having trouble
> with reading in the data from the file. I have managed to use the
> hGetContents and hGetLine methods of the IO library to read the data in but
> when it is read in, it is stored as an IO String type.
> 
> I would like to convert the input from the file into one large string so I
> can process it before sorting it.
> 
> After reading the whole file into a variable, how do I then convert that IO
> String to a String?

You do not have to convert from the abstract data type IO String into String.
You can access the string encapsulated in such abstract data type
using monad operations. The type IO String is the type of the computations
that perform input/output and produces a string as their result. You
can pass this result as an argument to a function of type String -> IO a
which may do the desired manipulation on the string and may also perform
some more input/output and should produce a result of type a.

The do expression is used for sequencing computations, possibly binding
their results to variables, which can then be used in subsequent
computations.

For example, suppose you want to write to standard output the number
of characters read from standard input:

module Main where
import Prelude
main :: IO ()
main = do xs <- getContents
	  putLine (show (length xs))

This program has two computations. The first one, getContents, read
all available characters from standard input and binds the resulting
string to the variable xs. The second one, putLine (show (length xs)),
finds the length of the string, converts the resulting integer to string
and writes it to standard output.

In your case you may write something similar that sort the input,
instead of find its length.

Romildo
-- 
Prof. José Romildo Malaquias <romildo@iceb.ufop.br>
Departamento de Computaçăo
Universidade Federal de Ouro Preto
Brasil


From C.Reinke@ukc.ac.uk Tue Oct 10 19:58:58 2000 Date: Tue, 10 Oct 2000 19:58:58 +0100 From: C.Reinke C.Reinke@ukc.ac.uk Subject: Haskell Problem
> The basic aim is to read in a file of data, sort it and then display it.
> 
> I have managed to get a sort to function properly but I am having trouble
> with reading in the data from the file. I have managed to use the
> hGetContents and hGetLine methods of the IO library to read the data in but
> when it is read in, it is stored as an IO String type.
> 
> I would like to convert the input from the file into one large string so I
> can process it before sorting it.
 
> After reading the whole file into a variable, how do I then convert that IO
> String to a String?

a) You don't "read the file into a variable". 

   It might sound picky, but it helps to keep the differences to 
   imperative languages clear in the use of language. In imperative
   languages, variables stand for boxes (storage locations), and you
   can put things into those boxes (read file contents into a variable).

   In functional languages, variables just stand for the things
   themselves.

b) There is no need for a conversion.
   The String is already there for your use. Well, almost. 

   IO String does not actually indicate a String in some capsule 
   but rather an IO-script that, when executed, returns a String. 
   So what you need is a program context 

	- in which your script can be executed 
	  (so that it can actually produce the String)

	- to which the String can be returned
	  (so that you can do something with it)

Putting these two together, you have a script a of type IO String

a :: IO String

and a program p that operates on the String

p :: String -> YourTypeHere

In your case, you want to display the results of your computations,
so p will itself be involved in IO:

p :: String -> IO ()

That means that you can use >>= to put a and p together

main :: IO ()
main = a >>= p

When main is executed, a is executed first and returns a String.
This String is passed as a parameter to p, and the result of 
applying p to the String is executed next.

You can also use do-notation to achieve the same thing

main = do { s <- a; p s }

Here, the variable s stands for a String. That String is not
yet known, so we use the variable instead of it. During execution,
occurrences of the variable will be replaced by a concrete string.

Similarly, the variable main stands for an IO-script. The script
is already known but it is convenient to use the variable instead.
Again, the variable will be replaced by the thing it stands for.

Hth,
Claus

PS. Examples for p:

p0 :: String -> IO ()
p0 s = putStr s

p1 :: String -> IO ()
p1 s = putStr (sort s)




From graemeturner@blueyonder.co.uk Tue Oct 10 20:11:08 2000 Date: Tue, 10 Oct 2000 20:11:08 +0100 From: Graeme Turner graemeturner@blueyonder.co.uk Subject: Doh!! Still don't quite understand
Hi, I e-mailed earlier about the IO String input but am still unable to get
anything to work

Thanks for the e-mails back but I still haven't got a grasp of what to
do.Here is a more detailed explanation as I may have been rather vague last
time!

I have a file of the following format :-

Surname , Forename , Age , Height e.g.
<String>, <String>, <Int> , <Int>

I have a tuple called Person which is defined as (String,String,Int,Int) as
you would expect.

What I want to do is to create a function which will
 1 take a line from the file
 2 create a Person tuple from the read information

I have defined functions to perform an insertion sort given a tuple of the
above specification.


Thanks for your time in explaining this to me

Graeme Turner





From uk1o@rz.uni-karlsruhe.de Tue Oct 10 22:36:11 2000 Date: Tue, 10 Oct 2000 23:36:11 +0200 From: Hannah Schroeter uk1o@rz.uni-karlsruhe.de Subject: Haskell Problem
Hello!

On Tue, Oct 10, 2000 at 07:11:14PM +0100, Graeme Turner wrote:
> [...]

> I am e-mailing you to see if you could offer me a bit of assistance. I have
> chosen to use
> Haskell in a minor assignment at my University, Heriot Watt in Edinburgh.
> The basic aim is to read in a file of data, sort it and then display it.

> [...]

How about

import List(sort)

main = do
    fileContents <- readFile "inputFile"
    -- the do notation hides the bind (>>=) operator.
    -- fileContents :: String (=== [Char])
    let l = lines fileContents
    -- l :: [String]
    let sortedL = sort l
    -- sortedL :: [String]
    let outputData = unlines sortedL
    -- outputData :: String
    putStr outputData

Regards, Hannah.


From uk1o@rz.uni-karlsruhe.de Tue Oct 10 22:45:32 2000 Date: Tue, 10 Oct 2000 23:45:32 +0200 From: Hannah Schroeter uk1o@rz.uni-karlsruhe.de Subject: Doh!! Still don't quite understand
Hello!

On Tue, Oct 10, 2000 at 08:11:08PM +0100, Graeme Turner wrote:

> I have a file of the following format :-

> Surname , Forename , Age , Height e.g.
> <String>, <String>, <Int> , <Int>

> I have a tuple called Person which is defined as (String,String,Int,Int) as
> you would expect.

> What I want to do is to create a function which will
>  1 take a line from the file
>  2 create a Person tuple from the read information

Don't think TOO imperatively.

type Record = (String {- surname -}, String {- forename -}, Int {- age -},
    Int {- height -}

Now write a function that parses one line into that record.

First a helper: Remove leading and trailing whitespace from a string:

import Char (isSpace)
cleanup :: String -> String
cleanup = reverse . dropWhile isSpace . reverse . dropWhile isSpace
-- Think about it!

parseLine :: String -> Record
parseLine s = (surName, foreName, age, height)
  where
    isComma = (',' ==)
    (surname', rest0) = break isComma s
    surname = cleanup surname'
    -- the tail removes the ,
    (foreName', rest1) = break isComma $ tail rest0
    foreName = cleanup foreName'
    (ageString, rest2) = break isComma $ tail rest1
    age = read ageString
    heightString = tail rest2 -- remove ,
    height = read heightString

Then, use that together with my previous mail:

import List(sort)

showRecord :: Record -> String
-- please do at least that for yourself. Mind ++ for string (in fact any list)
-- concatenation, and show to convert the integers into strings

main = do
    input <- readFile "inputfile"
    let ilines = lines input
    let iRecords = map parseLine iLines
    let oRecords = sort iRecords
    -- comparison on tuples is automatically defined if all element types
    -- are comparable (typeclass Ord)
    let olines = map showRecord oRecords
    let output = unlines olines
    putStr output
    -- or writeFile "outputfile" output

> I have defined functions to perform an insertion sort given a tuple of the
> above specification.

Why not import List(sort) or import List(sortBy), if you need your own
comparison?

> Thanks for your time in explaining this to me

> Graeme Turner

Regards, Hannah.


From lps@po.cwru.edu Tue Oct 10 23:12:05 2000 Date: Tue, 10 Oct 2000 19:12:05 -0300 From: Leon Smith lps@po.cwru.edu Subject: Haskell Problem
What you need to do is write a function that operates on a string that does
what you want it to,  and then use that to write some top-level I/O code.
If you have a function  sortFile :: String -> String, you would write
something like this for main:

main :: IO ()
main = do
    string <- getContents "theFile"
    putStr (sortFile string)

You can treat "string"  as a variable that has type String, not IO String,
which you can use anywhere you want in "main".  Keep in mind, though that
what is going on here is quite different than an assignment statement or
"converting" a IO String to a String.

This is not like the single assignment variables introduced in "where" or
"let" clauses, as we cannot substitute the value "(getContents "theFile")"
for the variable "string" in main.   This would lead to a type error, as
sortFile takes a String argument, not an IO String.

Nor is is it like the assignment statement in imperative programming
languages like C++ and Java for several reasons.   One can represent  "State
Transformers"  using monads, so what the IO monad is a state transformer
that modifies the state of the computer.

int a = 0;
int dirty_inc(int a) {
    a++;
    return i + a;
}

int main(int argc, char ** argv) {
    int i = dirty_inc(1);
    printf("%i %i", i, i);
}

Unlike monads, if you "substitute" dirty_inc(1) for i in main will result in
a legal program, but it isn't really a substitution, because it would modify
the behavior of the program.  Moreover, while we could write

main = do
    message <- return "Hello!"
    message <- return "Goodbye!"
    putStr message

and get "Goodbye!" as output, what really is happening is that you are
introducing two variables with the same name, and we can statically
determine which one we are referring to.  Thus if we write

main = do
    message <- return "Hello!"
    do
        message <- return "Goodbye! "
        putStr message
    putStr message

we will get "Goodbye! Hello!",  as output, not "Goodbye! Goodbye!".

To start to understand what's really going on,  do-notation is just
syntactic sugar for using the (>>=) operator.  Let's rewrite your example to
something that is syntactically equivalent:

main :: IO ()
main = getContents "theFile" >>= (\string -> putStr (sortFile string))

Which we could in turn rewrite as:

main :: IO ()
main = getContents "theFile" >>= output_sort

output_sort :: String -> IO ()
output_sort string = putStr (sortFile string)

What (>>=) does is that it takes the String returned inside of a IO String
value, and gives it to output_sort, which in turn may use that value in any
way it sees fit, *as long as output_sort returns another "IO a" value for
some type a.*    This is why we are not simply converting a IO String to a
String, because in order to use the String value in IO String, we must
produce a new IO monad.   This is summed up in (>>=)'s type, which is  (>>=)
:: IO a -> (a -> IO b) -> IO b, which can then be generalized to any monad
m, so (>>=) :: m a -> (a -> m b) -> m b.

best,
leon



From d95lars@dtek.chalmers.se Wed Oct 11 10:04:31 2000 Date: Wed, 11 Oct 2000 11:04:31 +0200 (MEST) From: Lars Lundgren d95lars@dtek.chalmers.se Subject: Haskell Problem
On Tue, 10 Oct 2000, Graeme Turner wrote:

> Hello,
> 
> I am e-mailing you to see if you could offer me a bit of assistance. I have
> chosen to use
> Haskell in a minor assignment at my University, Heriot Watt in Edinburgh.
> The basic aim is to read in a file of data, sort it and then display it.
> 
> I have managed to get a sort to function properly but I am having trouble
> with reading in the data from the file. I have managed to use the
> hGetContents and hGetLine methods of the IO library to read the data in but
> when it is read in, it is stored as an IO String type.
> 
> I would like to convert the input from the file into one large string so I
> can process it before sorting it.
> 

Aha, you want to use readFile :: String -> IO String.

> After reading the whole file into a variable, how do I then convert that IO
> String to a String?
> 

You use '<-' in the do notation.

readFile "myfile.txt"   -- here you have an IO String

do contents <- readFile "myfile.txt"
   return (lines contents)

-- here you "convert" the IO String (readFile "myfile.txt") to a String
-- (contents). Finally my example returns a list of the lines in the file.

I hope this helps.
/Lars L




From heringto@cs.unc.edu Thu Oct 12 15:10:25 2000 Date: Thu, 12 Oct 2000 10:10:25 -0400 From: Dean Herington heringto@cs.unc.edu Subject: documentation for Hugs-GHC extension libraries
I can't seem to find an easily printable (i.e., not HTML-in-many-pieces)
version of the documentation for the Hugs-GHC extension libraries.  Have
I overlooked it?

Thanks.
Dean Herington
heringto@cs.unc.edu




From Keith.Wansbrough@cl.cam.ac.uk Fri Oct 13 09:56:46 2000 Date: Fri, 13 Oct 2000 09:56:46 +0100 From: Keith Wansbrough Keith.Wansbrough@cl.cam.ac.uk Subject: documentation for Hugs-GHC extension libraries
> I can't seem to find an easily printable (i.e., not HTML-in-many-pieces)
> version of the documentation for the Hugs-GHC extension libraries.  Have
> I overlooked it?

pp150-261 of the PDF at

  http://www.haskell.org/ghc/docs/latest/set.pdf

(the "GHC Users' Guide" link at http://www.haskell.org/ghc/ -> Documentation).

HTH.

--KW 8-)
-- 
Keith Wansbrough <kw217@cl.cam.ac.uk>
http://www.cl.cam.ac.uk/users/kw217/
Cambridge University Computer Laboratory.



From fldrsimonmar@microsoft.com Fri Oct 13 10:15:25 2000 Date: Fri, 13 Oct 2000 02:15:25 -0700 From: Simon Marlow fldrsimonmar@microsoft.com Subject: documentation for Hugs-GHC extension libraries
> I can't seem to find an easily printable (i.e., not 
> HTML-in-many-pieces)
> version of the documentation for the Hugs-GHC extension 
> libraries.  Have
> I overlooked it?

There's a huge PDF file containing GHC's User Guide and the Library
documentation, of which the "lang" section of the Libraries is what used to
be the Hugs-Ghc extension libraries, here:

	http://www.haskell.org/ghc/docs/latest/set.pdf

Cheers,
	Simon


From Tom.Pledger@peace.com Thu Oct 19 04:25:02 2000 Date: Thu, 19 Oct 2000 16:25:02 +1300 (NZDT) From: Tom Pledger Tom.Pledger@peace.com Subject: Num class
Mark P Jones writes:
 > [...]
 > 
 > Defaulting only kicks in if (a) at least one class is numeric, and
 > (b) all classes are standard.  [...]  Defaulting was designed to
 > work in this way so that (i) it would catch and deal with the most
 > common problems occurring with numeric literals, and (ii) it would
 > not be used too often; defaulting is in general undesirable because
 > it can silently change the semantics.  Again, defaulting is an
 > example of a compromise in the design of Haskell.  Ideally, you'd
 > do without it all together, but if you went that way, you'd end up
 > having to write more type information in your programs.  And again,
 > I don't suppose there is a universally satisfactory point on this
 > spectrum.

A language extension for subtyping would be of some use there.  For
example, if Int is set up as a subtype of Integer, meaning that an Int
value is acceptable anywhere an Integer value is expected (with the
typechecker inserting the conversion code), the literal 42 can
unambiguously be assigned the type Int.

(This is a reprise of an airy suggestion I've posted before, hence the
move to the haskell-cafe list.  I'm still at the reading-about-
related-work stage of doing something more thorough about it.)

Regards,
Tom


From qrczak@knm.org.pl Thu Oct 19 07:17:18 2000 Date: 19 Oct 2000 06:17:18 GMT From: Marcin 'Qrczak' Kowalczyk qrczak@knm.org.pl Subject: Num class
Thu, 19 Oct 2000 16:25:02 +1300 (NZDT), Tom Pledger <Tom.Pledger@peace.com> pisze:

> A language extension for subtyping would be of some use there.  For
> example, if Int is set up as a subtype of Integer, meaning that an Int
> value is acceptable anywhere an Integer value is expected (with the
> typechecker inserting the conversion code), the literal 42 can
> unambiguously be assigned the type Int.

This disallows literals of a non-standard type Int8. Not good.

-- 
 __("<  Marcin Kowalczyk * qrczak@knm.org.pl http://qrczak.ids.net.pl/
 \__/
  ^^                      SYGNATURA ZASTĘPCZA
QRCZAK



From Tom.Pledger@peace.com Thu Oct 19 09:14:07 2000 Date: Thu, 19 Oct 2000 21:14:07 +1300 (NZDT) From: Tom Pledger Tom.Pledger@peace.com Subject: Num class
Marcin 'Qrczak' Kowalczyk writes:
 > Thu, 19 Oct 2000 16:25:02 +1300 (NZDT), Tom Pledger <Tom.Pledger@peace.com> pisze:
 > 
 > > A language extension for subtyping would be of some use there.  For
 > > example, if Int is set up as a subtype of Integer, meaning that an Int
 > > value is acceptable anywhere an Integer value is expected (with the
 > > typechecker inserting the conversion code), the literal 42 can
 > > unambiguously be assigned the type Int.
 > 
 > This disallows literals of a non-standard type Int8. Not good.

If you had such a non-standard type, I imagine you'd also declare
something like this:

    instance Subtype Int8  Int16 where ...
    instance Subtype Int16 Int24 where ...
    instance Subtype Int24 Int   where ...

and hence literals in the range -128 to 127 would be typed Int8, etc.

Regards,
Tom


From mk167280@students.mimuw.edu.pl Thu Oct 19 09:28:37 2000 Date: Thu, 19 Oct 2000 10:28:37 +0200 (CEST) From: Marcin 'Qrczak' Kowalczyk mk167280@students.mimuw.edu.pl Subject: Num class
On Thu, 19 Oct 2000, Tom Pledger wrote:

> If you had such a non-standard type, I imagine you'd also declare
> something like this:
> 
>     instance Subtype Int8  Int16 where ...
>     instance Subtype Int16 Int24 where ...
>     instance Subtype Int24 Int   where ...
> 
> and hence literals in the range -128 to 127 would be typed Int8, etc.

What would be the rule for typing integer literals? Currently it's
simple: fromIntegral (number::Integer), and Int8 is a completely
non-magical type.

With your proposal, assume that the programmer makes a bunch of subtype
declarations for his own types... What now?

(Assuming that subtyping can be reasonably embedded in the Haskell's type
system at all.)

A more concrete example. Does 10 have type Int8 or Word8? Is Int8 a
subtype of Word8, or the reverse? How could 10 be used as both Int8 and
Word8?

Current Haskell rules and not perfect: 12345::Int8 is legal. Conversions
are explicit and there is no distinction between always safe conversions
and those that may take an out of range parameter. But I'm happy with it;
conversions are rarely used anyway, rules are simple, and there is no
need of asking a question like: is every Int representable as Double
(the answer may depend on the implementation).

-- 
Marcin 'Qrczak' Kowalczyk



From simonpj@microsoft.com Thu Oct 19 09:51:05 2000 Date: Thu, 19 Oct 2000 01:51:05 -0700 From: Simon Peyton-Jones simonpj@microsoft.com Subject: Num class
[I'm sending this reply to haskell-cafe.  This one could run and run!]

| > The defaulting mechanism works as follows: If there is an unresolved
| > overloading error on a type variable a, which has as an *only*
| > constraint (Num a), then we take a to be the suitable default.
| 
| This is not what the Haskell 98 Report says. Section 4.3.4:
| 
| "In situations where an ambiguous type is discovered, an ambiguous
| type variable is defaultable if at least one of its classes is a
| numeric class (that is, Num or a subclass of Num) and if all of its
| classes are defined in the Prelude or a standard library (Figures 6--7
| show the numeric classes, and Figure 5 shows the classes defined in
| the Prelude.)"
| 
| I see no good reason for Show superclass of Num.

Quite so.  It's nothing to do with defaulting, and you could legitimately
complain about it.


| I agree that the default mechanism is ugly, and that at least the
| restriction about classes defined in standard libraries should
| be removed.

This was quite a conscious decision by the Haskell committee.  Defaulting
decisions are made silently, and they affect the meaning of the program.
So we consciously imposed quite heavy constraints to make sure that 
silent defaulting doesn't happen much.  (GHC has a flag that warns you
when it is happening.)  You can always write your program by adding an
explicit type signature.

You can argue that this was a poor decision.   Almost certainly there
will be programs for which a more liberal choice would be much more
convenient; perhaps Koen's is one.  So I'm not trying to say "we got it
right", only to explain why it is the way it is.

Making Show a superclass of Num wasn't nearly as conscious a choice.

Simon


From Tom.Pledger@peace.com Thu Oct 19 11:16:18 2000 Date: Thu, 19 Oct 2000 23:16:18 +1300 (NZDT) From: Tom Pledger Tom.Pledger@peace.com Subject: Num class
Marcin 'Qrczak' Kowalczyk writes:
 > On Thu, 19 Oct 2000, Tom Pledger wrote:
 > 
 > > If you had such a non-standard type, I imagine you'd also declare
 > > something like this:
 > > 
 > >     instance Subtype Int8  Int16 where ...
 > >     instance Subtype Int16 Int24 where ...
 > >     instance Subtype Int24 Int   where ...
 > > 
 > > and hence literals in the range -128 to 127 would be typed Int8, etc.
 > 
 > What would be the rule for typing integer literals? Currently it's
 > simple: fromIntegral (number::Integer), and Int8 is a completely
 > non-magical type.
 > 
 > With your proposal, assume that the programmer makes a bunch of subtype
 > declarations for his own types... What now?
 > 
 > (Assuming that subtyping can be reasonably embedded in the
 > Haskell's type system at all.)

Of course!  There's nothing quite like a nice flight of fancy.  :-)

A possible rule for typing integer literals is:

    intLitType x = tryToBeMoreSpecific (x `belongsTo`) IntegerT

    tryToBeMoreSpecific p t
      = case filter p (subtypes t) of
            []   -> t
            [t'] -> tryToBeMoreSpecific p t'
            ts   -> case filter p (leastSpecificCommonSubtypes ts) of
                        [t''] -> tryToBeMoreSpecific p t''
                        _     -> --ambiguity

It's more complicated for the implementer, but makes things simpler
for the programmer because we can then remove the Integral class and
some unintuitive dualities like length/genericLength.

 > A more concrete example. Does 10 have type Int8 or Word8? Is Int8 a
 > subtype of Word8, or the reverse? How could 10 be used as both Int8
 > and Word8?

There should be no subtype relationship between Int8 and Word8 in
either direction, because they denote different things: numbers and
encodings respectively.  We can say that every Int8 value *is* an
Int16 value, but there is no reasonable corresponding statement about
Int8 and Word8.

Faced with the choice, I'd say that 10 looks like a number, and make
it an Int8.  If Word8 literals are required, as opposed to terms like
fromEnum 10, they should have some other appearance like 10W.

 > Current Haskell rules and not perfect: 12345::Int8 is legal. Conversions
 > are explicit and there is no distinction between always safe conversions
 > and those that may take an out of range parameter. But I'm happy with it;
 > conversions are rarely used anyway, rules are simple, and there is no
 > need of asking a question like: is every Int representable as Double
 > (the answer may depend on the implementation).

I'd be very cautious about putting Double into any subtype
relationship at all, because its meaning is tied back into its
representation.  If you can't explain that "every X is a Y" without
referring to representation issues, you shouldn't be declaring X as a
subtype of Y!

Admittedly I dodged your general comment and focussed on your example.
I need to be more certain that subtyping is a feasible language
extension, before I try to tell you what you should be happy with.  :-)

Regards,
Tom


From mk167280@students.mimuw.edu.pl Thu Oct 19 12:11:04 2000 Date: Thu, 19 Oct 2000 13:11:04 +0200 (CEST) From: Marcin 'Qrczak' Kowalczyk mk167280@students.mimuw.edu.pl Subject: Num class
On Thu, 19 Oct 2000, Tom Pledger wrote:

>       = case filter p (subtypes t) of
>             []   -> t
>             [t'] -> tryToBeMoreSpecific p t'
>             ts   -> case filter p (leastSpecificCommonSubtypes ts) of
>                         [t''] -> tryToBeMoreSpecific p t''
>                         _     -> --ambiguity

Why it is bad:

- Adding a subtype elsewhere may make a program ambiguous. (Well, it is so
  with classes too, but at least it occurs only for overlapping instances,
  not unrelated subtypes of a generic type.)

- Assuming that "more specific" means something like "subtype", types
  are usually put in some ordered sequences. This means that it is not
  enough for each type to know a basic framework, but it must also
  know a type just above or below it. When various types come from
  unrelated sources, it is unlikely that they will know one another
  in the right order.

  For example when we have sized integer types (Int8 etc.) and
  types that are mirrors of C types (CInt, CLong etc.), the sequence
  of subtypes is a mix of both families. Should both families know
  each other? When Posix types (CPid etc.) are added, they are
  again mixed. I can't imagine where all these subtyping instances
  would be defined.

  What is worse, whether CLong is smaller or larger than Int is
  implementation defined. Currently it does not prevent having
  an implementation independent set of instances. Conversion in
  both directions is explicit anyway, and literals just have the
  right type. With your proposal a type that wants to put itself
  at the right place in the sequence containing Int and CLong is
  in trouble.

  Of course some of these types could be defined as synonyms, but
  it's not necessarily a good idea in general. It would make
  correctness of a code dependent on the implementation, by not
  catching code that makes unportable assumptions about type
  equivalences.

- When Int and CLong are isomorphic and thus declared subtypes of each
  other, wouldn't your proposal make the compiler loop? It's getting
  hairier and hairier.

> It's more complicated for the implementer, but makes things simpler
> for the programmer because we can then remove the Integral class and
> some unintuitive dualities like length/genericLength.

I doubt it's simpler fot the programmer. Certainly not simpler for me:
I know how the current rules work but I don't know how subtyping could
work :-)

> There should be no subtype relationship between Int8 and Word8 in
> either direction, because they denote different things: numbers and
> encodings respectively.

I hope we are not misunderstood. Word8 in GHC is an integer type
representing values 0..255. It is definitely a number, in the same sense
as Int8. Only their ranges are not contained in one another.

> If Word8 literals are required, as opposed to terms like fromEnum 10,
> they should have some other appearance like 10W.

And you are saying that your proposal is less ugly than the current
state? :-)

> I'd be very cautious about putting Double into any subtype
> relationship at all, because its meaning is tied back into its
> representation.

But people need to use floating point literals!

Each Double is representable as Rational. Your proposal thus lets 0.125
be typed as Double, which can be implicitly coerced to Rational when
needed. What about 0.1? It would lose precision when going to Rational
through Double. OTOH it should definitely be allowed as a Double value
too. How would you allow 0.1 to be used as either Rational or Double?

> If you can't explain that "every X is a Y" without referring to
> representation issues, you shouldn't be declaring X as a subtype of Y!

That's why subtypes are not a right tool for typing numeric literals :-)
(Assuming that they can fit Haskell at all.)

-- 
Marcin 'Qrczak' Kowalczyk







From mk167280@students.mimuw.edu.pl Thu Oct 19 12:24:28 2000 Date: Thu, 19 Oct 2000 13:24:28 +0200 (CEST) From: Marcin 'Qrczak' Kowalczyk mk167280@students.mimuw.edu.pl Subject: Num class
On Thu, 19 Oct 2000, Marcin 'Qrczak' Kowalczyk wrote:

> - Adding a subtype elsewhere may make a program ambiguous. (Well, it is so
>   with classes too, but at least it occurs only for overlapping instances,
>   not unrelated subtypes of a generic type.)

For example adding two unrelated subtypes of Int16 disallows using 1234 as
a value of type Integer!

-- 
Marcin 'Qrczak' Kowalczyk



From Tom.Pledger@peace.com Thu Oct 19 23:45:52 2000 Date: Fri, 20 Oct 2000 11:45:52 +1300 (NZDT) From: Tom Pledger Tom.Pledger@peace.com Subject: Num class
Marcin 'Qrczak' Kowalczyk writes:
 > [...]
 > 
 > Why it is bad:

I appreciate your objections, and will bear them in mind, but if my
hopes are going to be dashed, I'd rather it were done by one of the
issues I see as bigger:

  - How can we infer types like `(0==) :: Subtype Int a => a -> Bool' ?

  - What is F^{omega}_{<=} and am I trying to reinvent it and what
    makes it so hard to implement?

Feel free to call me a chicken for not answering your individual
points... yet.  :-)

 > [...]
 > > There should be no subtype relationship between Int8 and Word8 in
 > > either direction, because they denote different things: numbers and
 > > encodings respectively.
 > 
 > I hope we are not misunderstood. Word8 in GHC is an integer type
 > representing values 0..255. It is definitely a number, in the same sense
 > as Int8. Only their ranges are not contained in one another.

My mistake.  Thanks for the clarification.

 > > If Word8 literals are required, as opposed to terms like fromEnum 10,
 > > they should have some other appearance like 10W.
 > 
 > And you are saying that your proposal is less ugly than the current
 > state? :-)

Joking aside, yes, it may make the overall state even more beautiful.

Regards,
Tom


From pkot@ahoj.pl Wed Oct 25 09:48:57 2000 Date: Wed, 25 Oct 2000 10:48:57 +0200 From: =?ISO-8859-2?Q? Pawe=B3?= Kot pkot@ahoj.pl Subject: Haskell Programming Environment
Hello,

I'm writing my master thesis. Its subject is 'Haskell Programming
Environment'. It is (or rather will be) an extended text editor working in
graphical (XFree86) environment designed for Haskell programmers. It will be
implemented using Fudgets library.
I'm wondering what features would you like to find in such environment. What
should be neccessary, what would help, what would make writing programs
easier, etc.
I have some concepts, but I would like to hear some suggestions from you.

Thanks for all answers.

--
pkot
-- 
mailto:pkot@linuxnews.pl
http://newsreader.linuxnews.pl/

---
Przestań szukać. Zacznij znajdować. http://google.ahoj.pl


From jans@numeric-quest.com Wed Oct 25 09:28:03 2000 Date: Wed, 25 Oct 2000 04:28:03 -0400 (EDT) From: Jan Skibinski jans@numeric-quest.com Subject: Haskell Programming Environment
On Wed, 25 Oct 2000, =?ISO-8859-2?Q? Pawe=B3?= Kot wrote:

> Hello,
> 
> I'm writing my master thesis. Its subject is 'Haskell Programming
> Environment'. It is (or rather will be) an extended text editor working in
> graphical (XFree86) environment designed for Haskell programmers. It will be
> implemented using Fudgets library.
> I'm wondering what features would you like to find in such environment. What
> should be neccessary, what would help, what would make writing programs
> easier, etc.
> I have some concepts, but I would like to hear some suggestions from you.

	A module/class/instance/library browser perhaps? 
	Acquiring its information from standard libraries
	and other user defined directories?  Extracting comments,
	module comments, class comments, and implementation
	details to present them in some consistent way? Supporting
	incremental compilation, a'la hmake? With intelligent use of
	colorization, or other useful hints for programmers,
	for a start? Intelligent inspectors?

	In short - something that exists for ages in Smalltalk,
	or in Eiffel development environment, but with Haskell's
	extra capabilities, limitations and goals in view?

	I once did something of this sort for Java: 
	+ Java browser for Xcoral editor - in C
	+ Bongo based class hierarchy browser - in Java
	You can find more about it on our web pages.

	Jan
 
	


	

	 



From Doug_Ransom@pml.com Wed Oct 25 17:03:43 2000 Date: Wed, 25 Oct 2000 09:03:43 -0700 From: Doug Ransom Doug_Ransom@pml.com Subject: Haskell Programming Environment
I would like to be able to inspect the type of things easily by hovering my
mouse over an expression.  As a beginner, I find it hard sometimes to get
types correct in Haskell since often variables are not declared as a
specific type.  





> -----Original Message-----
> From: Jan Skibinski [mailto:jans@numeric-quest.com]
> Sent: Wednesday, October 25, 2000 1:28 AM
> To: Pawel Kot
> Cc: haskell-cafe@haskell.org
> Subject: Re: Haskell Programming Environment
> 
> 
> 
> 
> On Wed, 25 Oct 2000, =?ISO-8859-2?Q? Pawe=B3?= Kot wrote:
> 
> > Hello,
> > 
> > I'm writing my master thesis. Its subject is 'Haskell Programming
> > Environment'. It is (or rather will be) an extended text 
> editor working in
> > graphical (XFree86) environment designed for Haskell 
> programmers. It will be
> > implemented using Fudgets library.
> > I'm wondering what features would you like to find in such 
> environment. What
> > should be neccessary, what would help, what would make 
> writing programs
> > easier, etc.
> > I have some concepts, but I would like to hear some 
> suggestions from you.
> 
> 	A module/class/instance/library browser perhaps? 
> 	Acquiring its information from standard libraries
> 	and other user defined directories?  Extracting comments,
> 	module comments, class comments, and implementation
> 	details to present them in some consistent way? Supporting
> 	incremental compilation, a'la hmake? With intelligent use of
> 	colorization, or other useful hints for programmers,
> 	for a start? Intelligent inspectors?
> 
> 	In short - something that exists for ages in Smalltalk,
> 	or in Eiffel development environment, but with Haskell's
> 	extra capabilities, limitations and goals in view?
> 
> 	I once did something of this sort for Java: 
> 	+ Java browser for Xcoral editor - in C
> 	+ Bongo based class hierarchy browser - in Java
> 	You can find more about it on our web pages.
> 
> 	Jan
>  
> 	
> 
> 
> 	
> 
> 	 
> 
> 
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe@haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
> 


From lindig@eecs.harvard.edu Wed Oct 25 17:27:14 2000 Date: Wed, 25 Oct 2000 12:27:14 -0400 From: Christian Lindig lindig@eecs.harvard.edu Subject: Haskell Programming Environment
On Wed, Oct 25, 2000 at 09:03:43AM -0700, Doug Ransom wrote:
> I would like to be able to inspect the type of things easily by hovering my
> mouse over an expression.  As a beginner, I find it hard sometimes to get
> types correct in Haskell since often variables are not declared as a
> specific type.  

Since you are typically dealing with incomplete programs in an editor
this is really tough.  The PSG system was able to generate such
editors and I once saw it for the purely functional language Sample in
action:  you could mark any term with the mouse cursor and ask for its
type. 

-- Christian

@Article{Bahlke:1986:PSG,
  author =       "Rolf Bahlke and Gregor Snelting",
  title =        "The {PSG} System: From Formal Language Definitions to
                 Interactive Programming Environments",
  journal =      "ACM Transactions on Programming Languages and
                 Systems",
  volume =       "8",
  number =       "4",
  pages =        "547--576",
  month =        oct,
  year =         "1986",
  coden =        "ATPSDT",
  ISSN =         "0164-0925",
  bibdate =      "Sat Jan 06 09:41:04 1996",
  url =          "http://www.acm.org/pubs/toc/Abstracts/0164-0925/20890.html",
  abstract =     "The PSG programming system generator developed at the
                 Technical University of Darmstadt produces interactive,
                 language-specific programming environments from formal
                 language definitions. All language-dependent parts of
                 the environment are generated from an entirely
                 nonprocedural specification of the language's syntax,
                 context conditions, and dynamic semantics. The
                 generated environment consists of a language-based
                 editor, supporting systematic program development by
                 named program fragments, an interpreter, and a fragment
                 library system. The major component of the environment
                 is a full-screen editor, which allows both structure
                 and text editing. In structure mode the editor
                 guarantees prevention of both syntactic and semantic
                 errors, whereas in textual semantic analysis which is
                 based on unification. The algorithm will immediately
                 detect semantic errors even in incomplete program
                 fragments. The dynamic semantics of the language are
                 defined in denotational style using a functional
                 language based on the lambda calculus. Program
                 fragments are compiled to terms of the functional
                 language which are executed by an interpreter. The PSG
                 generator has been used to produce environments for
                 Pascal, ALGOL 60, MODULA-2, and the formal language
                 definition language itself.",
  acknowledgement = ack-pb # " and " # ack-nhfb,
  keywords =     "algorithms; design; documentation; languages; theory;
                 theory and verification and Hybrid editor and
                 unification-based incremental semantic analysis;
                 verification",
  owner =        "manning",
  review =       "ACM CR 8711-0926",
  subject =      "{\bf D.3.4}: Software, PROGRAMMING LANGUAGES,
                 Processors, Compilers. {\bf D.2.3}: Software, SOFTWARE
                 ENGINEERING, Coding, Program editors. {\bf D.2.6}:
                 Software, SOFTWARE ENGINEERING, Programming
                 Environments. {\bf D.3.1}: Software, PROGRAMMING
                 LANGUAGES, Formal Definitions and Theory, Semantics.
                 {\bf D.3.1}: Software, PROGRAMMING LANGUAGES, Formal
                 Definitions and Theory, Syntax. {\bf D.2.3}: Software,
                 SOFTWARE ENGINEERING, Coding, Pretty printers. {\bf
                 F.3.2}: Theory of Computation, LOGICS AND MEANINGS OF
                 PROGRAMS, Semantics of Programming Languages. {\bf
                 F.4.2}: Theory of Computation, MATHEMATICAL LOGIC AND
                 FORMAL LANGUAGES, Grammars and Other Rewriting Systems,
                 Grammar types. {\bf F.4.2}: Theory of Computation,
                 MATHEMATICAL LOGIC AND FORMAL LANGUAGES, Grammars and
                 Other Rewriting Systems, Parsing. {\bf I.2.3}:
                 Computing Methodologies, ARTIFICIAL INTELLIGENCE,
                 Deduction and Theorem Proving, Deduction.",
}

-- 
Christian Lindig          Harvard University - DEAS
lindig@eecs.harvard.edu   33 Oxford St, MD 242, Cambridge MA 02138
phone: +1 (617) 496-7157  http://www.eecs.harvard.edu/~lindig/


From Keith.Wansbrough@cl.cam.ac.uk Wed Oct 25 17:37:25 2000 Date: Wed, 25 Oct 2000 17:37:25 +0100 From: Keith Wansbrough Keith.Wansbrough@cl.cam.ac.uk Subject: Haskell Programming Environment
> On Wed, Oct 25, 2000 at 09:03:43AM -0700, Doug Ransom wrote:
> > I would like to be able to inspect the type of things easily by hovering my
> > mouse over an expression.  As a beginner, I find it hard sometimes to get
> > types correct in Haskell since often variables are not declared as a
> > specific type.  
> 
> Since you are typically dealing with incomplete programs in an editor
> this is really tough.  The PSG system was able to generate such
> editors and I once saw it for the purely functional language Sample in
> action:  you could mark any term with the mouse cursor and ask for its
> type. 

One of the emacs modes for Haskell gives the type of the identifier
the cursor is in in the modeline.  It does this by examining the type
signatures in the current file, and having the prelude type signatures
built-in.  This is quite helpful, if incomplete, and fairly easy to
implement.

--KW 8-)


-- 
Keith Wansbrough <kw217@cl.cam.ac.uk>
http://www.cl.cam.ac.uk/users/kw217/
Cambridge University Computer Laboratory.



From hwloidl@cee.hw.ac.uk Wed Oct 25 18:02:47 2000 Date: Wed, 25 Oct 2000 18:02:47 +0100 From: Hans Wolfgang Loidl hwloidl@cee.hw.ac.uk Subject: Haskell Programming Environment
Hi, 

>  > On Wed, Oct 25, 2000 at 09:03:43AM -0700, Doug Ransom wrote:
>  > > I would like to be able to inspect the type of things easily by hovering my
>  > > mouse over an expression.  As a beginner, I find it hard sometimes to get
>  > > types correct in Haskell since often variables are not declared as a
>  > > specific type.  
>  > 
>  > Since you are typically dealing with incomplete programs in an editor
>  > this is really tough.  The PSG system was able to generate such
>  > editors and I once saw it for the purely functional language Sample in
>  > action:  you could mark any term with the mouse cursor and ask for its
>  > type. 

>  One of the emacs modes for Haskell gives the type of the identifier
>  the cursor is in in the modeline.  It does this by examining the type
>  signatures in the current file, and having the prelude type signatures
>  built-in.  This is quite helpful, if incomplete, and fairly easy to
>  implement.

To increase its usefulness for multi-module programs, I have been planning
for a long time to extract type info out of .hi files and feed it into the
haskell-doc emacs module. Well, one day I may write an elisp parser to do
that. In the meantime there is of course the possibility of pre-processing
the Haskell source (or .hi) and feeding the type info as an elisp
expression directly to haskell-doc. Here is the relevant bit from the docu:

;; If you want to define your own strings for some identifiers define an
;; alist of (ID . STRING) and set `haskell-doc-show-user-defined' to t. 
;; E.g:
;;
;;   (setq haskell-doc-show-user-defined t)
;;   (setq haskell-doc-user-defined-ids 
;;	(list 
;;	   '("main" . "just another pathetic main function")
;;	   '("foo" . "a very dummy name")
;;	   '("bar" . "another dummy name")))

Hope that helps,
-- 
  Hans Wolfgang


From ahey@eptools.demon.co.uk Wed Oct 25 16:47:22 2000 Date: Wed, 25 Oct 2000 16:47:22 +0100 (BST) From: Adrian Hey ahey@eptools.demon.co.uk Subject: Haskell Programming Environment
Hello,

On Wed 25 Oct,  Pawe=B3 Kot wrote:
> I have some concepts, but I would like to hear some suggestions from you.

How about being able to type check partially written modules?

Carlos Camarao posted a link to an implementation of type system CT
in Haskell..
   http://www.dcc.ufmg.br/~camarao/CT/CTinH.tar.gz

Of course you don't really want to use a different type sytem from that
currently used by Haskell. I believe this system makes use of 'principal
typings' to infer the types of free variables from the context they are
used, so it can be used to type check incomplete modules/programs. I can't
think why such a system should be incompatible with the current Haskell typ=
e
system. It seems quite appropriate for an interactive development
environment and should be able to give more intelligent error reports.

Regards
--=20
Adrian Hey



From C.Reinke@ukc.ac.uk Wed Oct 25 18:49:30 2000 Date: Wed, 25 Oct 2000 18:49:30 +0100 From: C.Reinke C.Reinke@ukc.ac.uk Subject: Haskell Programming Environment
> One of the emacs modes for Haskell gives the type of the identifier
> the cursor is in in the modeline.  It does this by examining the type
> signatures in the current file, and having the prelude type signatures
> built-in.  This is quite helpful, if incomplete, and fairly easy to
> implement.

Similar shortcuts are possible for other aspects, and might help
to produce something useful within the constraints of an MSc project.
Finding a reasonable compromise between producing something for an
MSc and producing something that will remain in use and that others
could build on later would be the first challenge, I think.

Personally, I couldn't care less about yet another non-portable
IDE demo bound to one specific, non-standard, smallish editor 
and one specific graphics library with one specific OS. It might 
get a small user base, but is likely to be out of date before it 
can grow to a functionality that could attract more users. But 
that's just my personal opinion..

The results of this survey and your own thoughts about what
the specific issues in a Haskell Programming Environment might
be, what functionality should be provided, and how, have a 
greater likelihood to be of lasting value.

If you want to produce anything "real", you will want to reuse
the language knowledge built into existing implementations. If you
then want to remain portable, a good route would be to define an
interface between the HPE and some Haskell implementation, 
specifying exactly which functionality the HPE would want to 
access, and how.

Examples:

 - syntax-awareness. Experience with syntax-directed editors shows
   that users don't like to be locked into the syntax, they want
   some leeway for errors in intermediate stages. Also, many 
   programmers don't want to drop their favourite, productive, 
   proven and portable editor for the ones built into IDEs. Still, 
   the editor should be aware of the syntax of the current language
   (those regular-expression-based syntax-highlighters are nothing
   but a stop-gap measure). Having a standard interface to the
   implementation's parser (where is the next subexpression?
   where is next enclosing context? where and what is the next
   syntax error?..).

 - scope&type awareness. A natural extension of the above with 
   an interface to the implementation's symbol table (where is
   the binding occurence for this variable? what the type of
   this expression? what are the constructors/class instances
   for this type? which identifiers with which types are exported 
   from this module?..)

 - other language-specific interactions. (evaluate current 
   expression in current environment; browse module graph; 
   browse class graph; compile&run; instrument for debugging;..)

Have a look at the functionality provided in Hugs and try to
define an interface that could support that functionality from
within a standard editor, without being dependent on Hugs. 

There used to be an idea of having a more modular Haskell 
implementation with interfaces between all parts, including an 
interface between Hugs-like frontend and background compiler 
and runtime system (part of the Haskell Execution Platform, HEP;-). 
That got rescheduled to low priority, but might still be a useful 
starting point (http://www.haskell.org/ghc/docs/papers/hep.ps.gz).

Of course, that would be only one side of a modular HPE. The
other half would be to make sure that standard programmer
editors (Emacs, VIM, ..) get the necessary stub functionality
to make use of the interfaces. And finally, both Haskell 
implementers and Editor developers would need to be convinced
to support those interfaces.. After that, implementing and
adding functionality using the editor and implementation 
interfaces would be the lesser problem.

The really good IDEs are either built on meta-programming and 
reflective facilities in the underlying programming language
or integrated into one particular implementation. 

Trying to guess types and syntax is either a lot of work 
(duplicating what has gone into existing implementations) or 
just a hack.

Claus




From luti@linkexpress.com.br Wed Oct 25 23:25:34 2000 Date: Wed, 25 Oct 2000 20:25:34 -0200 From: Luciano Caixeta Moreira luti@linkexpress.com.br Subject: (no subject)
This is a multi-part message in MIME format.

------=_NextPart_000_001F_01C03EC1.BA8BACA0
Content-Type: text/plain;
	charset="iso-8859-1"
Content-Transfer-Encoding: quoted-printable

unsubscribe luti@linkexpress.com.br

------=_NextPart_000_001F_01C03EC1.BA8BACA0
Content-Type: text/html;
	charset="iso-8859-1"
Content-Transfer-Encoding: quoted-printable

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<HTML><HEAD>
<META http-equiv=3DContent-Type content=3D"text/html; =
charset=3Diso-8859-1">
<META content=3D"MSHTML 5.50.4134.100" name=3DGENERATOR>
<STYLE></STYLE>
</HEAD>
<BODY bgColor=3D#ffffff>
<DIV><FONT face=3DArial size=3D2>unsubscribe=20
luti@linkexpress.com.br</FONT></DIV></BODY></HTML>

------=_NextPart_000_001F_01C03EC1.BA8BACA0--



From graemeturner@blueyonder.co.uk Tue Oct 10 19:11:14 2000 From: graemeturner@blueyonder.co.uk (Graeme Turner) Date: Tue, 10 Oct 2000 19:11:14 +0100 Subject: Haskell Problem Message-ID: <001301c032e5$7b113a00$02fd10ac@graeme> Hello, I am e-mailing you to see if you could offer me a bit of assistance. I have chosen to use Haskell in a minor assignment at my University, Heriot Watt in Edinburgh. The basic aim is to read in a file of data, sort it and then display it. I have managed to get a sort to function properly but I am having trouble with reading in the data from the file. I have managed to use the hGetContents and hGetLine methods of the IO library to read the data in but when it is read in, it is stored as an IO String type. I would like to convert the input from the file into one large string so I can process it before sorting it. After reading the whole file into a variable, how do I then convert that IO String to a String? I would be very grateful if you could offer me some assistance in this matter. Thanks Graeme Turner From romildo@urano.iceb.ufop.br Tue Oct 10 18:49:59 2000 From: romildo@urano.iceb.ufop.br (=?iso-8859-1?Q?Jos=E9_Romildo_Malaquias?=) Date: Tue, 10 Oct 2000 15:49:59 -0200 Subject: Haskell Problem In-Reply-To: <001301c032e5$7b113a00$02fd10ac@graeme>; from graemeturner@blueyonder.co.uk on Tue, Oct 10, 2000 at 07:11:14PM +0100 References: <001301c032e5$7b113a00$02fd10ac@graeme> Message-ID: <20001010154959.A6976@urano.iceb.ufop.br> On Tue, Oct 10, 2000 at 07:11:14PM +0100, Graeme Turner wrote: > The basic aim is to read in a file of data, sort it and then display it. > > I have managed to get a sort to function properly but I am having trouble > with reading in the data from the file. I have managed to use the > hGetContents and hGetLine methods of the IO library to read the data in but > when it is read in, it is stored as an IO String type. > > I would like to convert the input from the file into one large string so I > can process it before sorting it. > > After reading the whole file into a variable, how do I then convert that IO > String to a String? You do not have to convert from the abstract data type IO String into String. You can access the string encapsulated in such abstract data type using monad operations. The type IO String is the type of the computations that perform input/output and produces a string as their result. You can pass this result as an argument to a function of type String -> IO a which may do the desired manipulation on the string and may also perform some more input/output and should produce a result of type a. The do expression is used for sequencing computations, possibly binding their results to variables, which can then be used in subsequent computations. For example, suppose you want to write to standard output the number of characters read from standard input: module Main where import Prelude main :: IO () main = do xs <- getContents putLine (show (length xs)) This program has two computations. The first one, getContents, read all available characters from standard input and binds the resulting string to the variable xs. The second one, putLine (show (length xs)), finds the length of the string, converts the resulting integer to string and writes it to standard output. In your case you may write something similar that sort the input, instead of find its length. Romildo -- Prof. José Romildo Malaquias Departamento de Computaçăo Universidade Federal de Ouro Preto Brasil From C.Reinke@ukc.ac.uk Tue Oct 10 19:58:58 2000 From: C.Reinke@ukc.ac.uk (C.Reinke) Date: Tue, 10 Oct 2000 19:58:58 +0100 Subject: Haskell Problem In-Reply-To: Your message of "Tue, 10 Oct 2000 19:11:14 BST." <001301c032e5$7b113a00$02fd10ac@graeme> Message-ID: > The basic aim is to read in a file of data, sort it and then display it. > > I have managed to get a sort to function properly but I am having trouble > with reading in the data from the file. I have managed to use the > hGetContents and hGetLine methods of the IO library to read the data in but > when it is read in, it is stored as an IO String type. > > I would like to convert the input from the file into one large string so I > can process it before sorting it. > After reading the whole file into a variable, how do I then convert that IO > String to a String? a) You don't "read the file into a variable". It might sound picky, but it helps to keep the differences to imperative languages clear in the use of language. In imperative languages, variables stand for boxes (storage locations), and you can put things into those boxes (read file contents into a variable). In functional languages, variables just stand for the things themselves. b) There is no need for a conversion. The String is already there for your use. Well, almost. IO String does not actually indicate a String in some capsule but rather an IO-script that, when executed, returns a String. So what you need is a program context - in which your script can be executed (so that it can actually produce the String) - to which the String can be returned (so that you can do something with it) Putting these two together, you have a script a of type IO String a :: IO String and a program p that operates on the String p :: String -> YourTypeHere In your case, you want to display the results of your computations, so p will itself be involved in IO: p :: String -> IO () That means that you can use >>= to put a and p together main :: IO () main = a >>= p When main is executed, a is executed first and returns a String. This String is passed as a parameter to p, and the result of applying p to the String is executed next. You can also use do-notation to achieve the same thing main = do { s <- a; p s } Here, the variable s stands for a String. That String is not yet known, so we use the variable instead of it. During execution, occurrences of the variable will be replaced by a concrete string. Similarly, the variable main stands for an IO-script. The script is already known but it is convenient to use the variable instead. Again, the variable will be replaced by the thing it stands for. Hth, Claus PS. Examples for p: p0 :: String -> IO () p0 s = putStr s p1 :: String -> IO () p1 s = putStr (sort s) From graemeturner@blueyonder.co.uk Tue Oct 10 20:11:08 2000 From: graemeturner@blueyonder.co.uk (Graeme Turner) Date: Tue, 10 Oct 2000 20:11:08 +0100 Subject: Doh!! Still don't quite understand Message-ID: <002b01c032ed$d9622620$02fd10ac@graeme> Hi, I e-mailed earlier about the IO String input but am still unable to get anything to work Thanks for the e-mails back but I still haven't got a grasp of what to do.Here is a more detailed explanation as I may have been rather vague last time! I have a file of the following format :- Surname , Forename , Age , Height e.g. , , , I have a tuple called Person which is defined as (String,String,Int,Int) as you would expect. What I want to do is to create a function which will 1 take a line from the file 2 create a Person tuple from the read information I have defined functions to perform an insertion sort given a tuple of the above specification. Thanks for your time in explaining this to me Graeme Turner From uk1o@rz.uni-karlsruhe.de Tue Oct 10 22:36:11 2000 From: uk1o@rz.uni-karlsruhe.de (Hannah Schroeter) Date: Tue, 10 Oct 2000 23:36:11 +0200 Subject: Haskell Problem In-Reply-To: <001301c032e5$7b113a00$02fd10ac@graeme>; from graemeturner@blueyonder.co.uk on Tue, Oct 10, 2000 at 07:11:14PM +0100 References: <001301c032e5$7b113a00$02fd10ac@graeme> Message-ID: <20001010233611.A5990@rz.uni-karlsruhe.de> Hello! On Tue, Oct 10, 2000 at 07:11:14PM +0100, Graeme Turner wrote: > [...] > I am e-mailing you to see if you could offer me a bit of assistance. I have > chosen to use > Haskell in a minor assignment at my University, Heriot Watt in Edinburgh. > The basic aim is to read in a file of data, sort it and then display it. > [...] How about import List(sort) main = do fileContents <- readFile "inputFile" -- the do notation hides the bind (>>=) operator. -- fileContents :: String (=== [Char]) let l = lines fileContents -- l :: [String] let sortedL = sort l -- sortedL :: [String] let outputData = unlines sortedL -- outputData :: String putStr outputData Regards, Hannah. From uk1o@rz.uni-karlsruhe.de Tue Oct 10 22:45:32 2000 From: uk1o@rz.uni-karlsruhe.de (Hannah Schroeter) Date: Tue, 10 Oct 2000 23:45:32 +0200 Subject: Doh!! Still don't quite understand In-Reply-To: <002b01c032ed$d9622620$02fd10ac@graeme>; from graemeturner@blueyonder.co.uk on Tue, Oct 10, 2000 at 08:11:08PM +0100 References: <002b01c032ed$d9622620$02fd10ac@graeme> Message-ID: <20001010234532.B5990@rz.uni-karlsruhe.de> Hello! On Tue, Oct 10, 2000 at 08:11:08PM +0100, Graeme Turner wrote: > I have a file of the following format :- > Surname , Forename , Age , Height e.g. > , , , > I have a tuple called Person which is defined as (String,String,Int,Int) as > you would expect. > What I want to do is to create a function which will > 1 take a line from the file > 2 create a Person tuple from the read information Don't think TOO imperatively. type Record = (String {- surname -}, String {- forename -}, Int {- age -}, Int {- height -} Now write a function that parses one line into that record. First a helper: Remove leading and trailing whitespace from a string: import Char (isSpace) cleanup :: String -> String cleanup = reverse . dropWhile isSpace . reverse . dropWhile isSpace -- Think about it! parseLine :: String -> Record parseLine s = (surName, foreName, age, height) where isComma = (',' ==) (surname', rest0) = break isComma s surname = cleanup surname' -- the tail removes the , (foreName', rest1) = break isComma $ tail rest0 foreName = cleanup foreName' (ageString, rest2) = break isComma $ tail rest1 age = read ageString heightString = tail rest2 -- remove , height = read heightString Then, use that together with my previous mail: import List(sort) showRecord :: Record -> String -- please do at least that for yourself. Mind ++ for string (in fact any list) -- concatenation, and show to convert the integers into strings main = do input <- readFile "inputfile" let ilines = lines input let iRecords = map parseLine iLines let oRecords = sort iRecords -- comparison on tuples is automatically defined if all element types -- are comparable (typeclass Ord) let olines = map showRecord oRecords let output = unlines olines putStr output -- or writeFile "outputfile" output > I have defined functions to perform an insertion sort given a tuple of the > above specification. Why not import List(sort) or import List(sortBy), if you need your own comparison? > Thanks for your time in explaining this to me > Graeme Turner Regards, Hannah. From lps@po.cwru.edu Tue Oct 10 23:12:05 2000 From: lps@po.cwru.edu (Leon Smith) Date: Tue, 10 Oct 2000 19:12:05 -0300 Subject: Haskell Problem References: <001301c032e5$7b113a00$02fd10ac@graeme> Message-ID: <00d501c03307$1fe590a0$64fd1681@cwru.edu> What you need to do is write a function that operates on a string that does what you want it to, and then use that to write some top-level I/O code. If you have a function sortFile :: String -> String, you would write something like this for main: main :: IO () main = do string <- getContents "theFile" putStr (sortFile string) You can treat "string" as a variable that has type String, not IO String, which you can use anywhere you want in "main". Keep in mind, though that what is going on here is quite different than an assignment statement or "converting" a IO String to a String. This is not like the single assignment variables introduced in "where" or "let" clauses, as we cannot substitute the value "(getContents "theFile")" for the variable "string" in main. This would lead to a type error, as sortFile takes a String argument, not an IO String. Nor is is it like the assignment statement in imperative programming languages like C++ and Java for several reasons. One can represent "State Transformers" using monads, so what the IO monad is a state transformer that modifies the state of the computer. int a = 0; int dirty_inc(int a) { a++; return i + a; } int main(int argc, char ** argv) { int i = dirty_inc(1); printf("%i %i", i, i); } Unlike monads, if you "substitute" dirty_inc(1) for i in main will result in a legal program, but it isn't really a substitution, because it would modify the behavior of the program. Moreover, while we could write main = do message <- return "Hello!" message <- return "Goodbye!" putStr message and get "Goodbye!" as output, what really is happening is that you are introducing two variables with the same name, and we can statically determine which one we are referring to. Thus if we write main = do message <- return "Hello!" do message <- return "Goodbye! " putStr message putStr message we will get "Goodbye! Hello!", as output, not "Goodbye! Goodbye!". To start to understand what's really going on, do-notation is just syntactic sugar for using the (>>=) operator. Let's rewrite your example to something that is syntactically equivalent: main :: IO () main = getContents "theFile" >>= (\string -> putStr (sortFile string)) Which we could in turn rewrite as: main :: IO () main = getContents "theFile" >>= output_sort output_sort :: String -> IO () output_sort string = putStr (sortFile string) What (>>=) does is that it takes the String returned inside of a IO String value, and gives it to output_sort, which in turn may use that value in any way it sees fit, *as long as output_sort returns another "IO a" value for some type a.* This is why we are not simply converting a IO String to a String, because in order to use the String value in IO String, we must produce a new IO monad. This is summed up in (>>=)'s type, which is (>>=) :: IO a -> (a -> IO b) -> IO b, which can then be generalized to any monad m, so (>>=) :: m a -> (a -> m b) -> m b. best, leon From d95lars@dtek.chalmers.se Wed Oct 11 10:04:31 2000 From: d95lars@dtek.chalmers.se (Lars Lundgren) Date: Wed, 11 Oct 2000 11:04:31 +0200 (MEST) Subject: Haskell Problem In-Reply-To: <001301c032e5$7b113a00$02fd10ac@graeme> Message-ID: On Tue, 10 Oct 2000, Graeme Turner wrote: > Hello, > > I am e-mailing you to see if you could offer me a bit of assistance. I have > chosen to use > Haskell in a minor assignment at my University, Heriot Watt in Edinburgh. > The basic aim is to read in a file of data, sort it and then display it. > > I have managed to get a sort to function properly but I am having trouble > with reading in the data from the file. I have managed to use the > hGetContents and hGetLine methods of the IO library to read the data in but > when it is read in, it is stored as an IO String type. > > I would like to convert the input from the file into one large string so I > can process it before sorting it. > Aha, you want to use readFile :: String -> IO String. > After reading the whole file into a variable, how do I then convert that IO > String to a String? > You use '<-' in the do notation. readFile "myfile.txt" -- here you have an IO String do contents <- readFile "myfile.txt" return (lines contents) -- here you "convert" the IO String (readFile "myfile.txt") to a String -- (contents). Finally my example returns a list of the lines in the file. I hope this helps. /Lars L From heringto@cs.unc.edu Thu Oct 12 15:10:25 2000 From: heringto@cs.unc.edu (Dean Herington) Date: Thu, 12 Oct 2000 10:10:25 -0400 Subject: documentation for Hugs-GHC extension libraries Message-ID: <39E5C650.F640EF85@cs.unc.edu> I can't seem to find an easily printable (i.e., not HTML-in-many-pieces) version of the documentation for the Hugs-GHC extension libraries. Have I overlooked it? Thanks. Dean Herington heringto@cs.unc.edu From Keith.Wansbrough@cl.cam.ac.uk Fri Oct 13 09:56:46 2000 From: Keith.Wansbrough@cl.cam.ac.uk (Keith Wansbrough) Date: Fri, 13 Oct 2000 09:56:46 +0100 Subject: documentation for Hugs-GHC extension libraries In-Reply-To: Your message of "Thu, 12 Oct 2000 10:10:25 EDT." <39E5C650.F640EF85@cs.unc.edu> Message-ID: > I can't seem to find an easily printable (i.e., not HTML-in-many-pieces) > version of the documentation for the Hugs-GHC extension libraries. Have > I overlooked it? pp150-261 of the PDF at http://www.haskell.org/ghc/docs/latest/set.pdf (the "GHC Users' Guide" link at http://www.haskell.org/ghc/ -> Documentation). HTH. --KW 8-) -- Keith Wansbrough http://www.cl.cam.ac.uk/users/kw217/ Cambridge University Computer Laboratory. From fldrsimonmar@microsoft.com Fri Oct 13 10:15:25 2000 From: fldrsimonmar@microsoft.com (Simon Marlow) Date: Fri, 13 Oct 2000 02:15:25 -0700 Subject: documentation for Hugs-GHC extension libraries Message-ID: <9584A4A864BD8548932F2F88EB30D1C610CDFF@TVP-MSG-01.europe.corp.microsoft.com> > I can't seem to find an easily printable (i.e., not > HTML-in-many-pieces) > version of the documentation for the Hugs-GHC extension > libraries. Have > I overlooked it? There's a huge PDF file containing GHC's User Guide and the Library documentation, of which the "lang" section of the Libraries is what used to be the Hugs-Ghc extension libraries, here: http://www.haskell.org/ghc/docs/latest/set.pdf Cheers, Simon From Tom.Pledger@peace.com Thu Oct 19 04:25:02 2000 From: Tom.Pledger@peace.com (Tom Pledger) Date: Thu, 19 Oct 2000 16:25:02 +1300 (NZDT) Subject: Num class In-Reply-To: References: Message-ID: <14830.27022.84407.626756@waytogo.peace.co.nz> Mark P Jones writes: > [...] > > Defaulting only kicks in if (a) at least one class is numeric, and > (b) all classes are standard. [...] Defaulting was designed to > work in this way so that (i) it would catch and deal with the most > common problems occurring with numeric literals, and (ii) it would > not be used too often; defaulting is in general undesirable because > it can silently change the semantics. Again, defaulting is an > example of a compromise in the design of Haskell. Ideally, you'd > do without it all together, but if you went that way, you'd end up > having to write more type information in your programs. And again, > I don't suppose there is a universally satisfactory point on this > spectrum. A language extension for subtyping would be of some use there. For example, if Int is set up as a subtype of Integer, meaning that an Int value is acceptable anywhere an Integer value is expected (with the typechecker inserting the conversion code), the literal 42 can unambiguously be assigned the type Int. (This is a reprise of an airy suggestion I've posted before, hence the move to the haskell-cafe list. I'm still at the reading-about- related-work stage of doing something more thorough about it.) Regards, Tom From qrczak@knm.org.pl Thu Oct 19 07:17:18 2000 From: qrczak@knm.org.pl (Marcin 'Qrczak' Kowalczyk) Date: 19 Oct 2000 06:17:18 GMT Subject: Num class References: <14830.27022.84407.626756@waytogo.peace.co.nz> Message-ID: Thu, 19 Oct 2000 16:25:02 +1300 (NZDT), Tom Pledger pisze: > A language extension for subtyping would be of some use there. For > example, if Int is set up as a subtype of Integer, meaning that an Int > value is acceptable anywhere an Integer value is expected (with the > typechecker inserting the conversion code), the literal 42 can > unambiguously be assigned the type Int. This disallows literals of a non-standard type Int8. Not good. -- __("< Marcin Kowalczyk * qrczak@knm.org.pl http://qrczak.ids.net.pl/ \__/ ^^ SYGNATURA ZASTĘPCZA QRCZAK From Tom.Pledger@peace.com Thu Oct 19 09:14:07 2000 From: Tom.Pledger@peace.com (Tom Pledger) Date: Thu, 19 Oct 2000 21:14:07 +1300 (NZDT) Subject: Num class In-Reply-To: References: <14830.27022.84407.626756@waytogo.peace.co.nz> Message-ID: <14830.44367.723411.860256@waytogo.peace.co.nz> Marcin 'Qrczak' Kowalczyk writes: > Thu, 19 Oct 2000 16:25:02 +1300 (NZDT), Tom Pledger pisze: > > > A language extension for subtyping would be of some use there. For > > example, if Int is set up as a subtype of Integer, meaning that an Int > > value is acceptable anywhere an Integer value is expected (with the > > typechecker inserting the conversion code), the literal 42 can > > unambiguously be assigned the type Int. > > This disallows literals of a non-standard type Int8. Not good. If you had such a non-standard type, I imagine you'd also declare something like this: instance Subtype Int8 Int16 where ... instance Subtype Int16 Int24 where ... instance Subtype Int24 Int where ... and hence literals in the range -128 to 127 would be typed Int8, etc. Regards, Tom From mk167280@students.mimuw.edu.pl Thu Oct 19 09:28:37 2000 From: mk167280@students.mimuw.edu.pl (Marcin 'Qrczak' Kowalczyk) Date: Thu, 19 Oct 2000 10:28:37 +0200 (CEST) Subject: Num class In-Reply-To: <14830.44367.723411.860256@waytogo.peace.co.nz> Message-ID: On Thu, 19 Oct 2000, Tom Pledger wrote: > If you had such a non-standard type, I imagine you'd also declare > something like this: > > instance Subtype Int8 Int16 where ... > instance Subtype Int16 Int24 where ... > instance Subtype Int24 Int where ... > > and hence literals in the range -128 to 127 would be typed Int8, etc. What would be the rule for typing integer literals? Currently it's simple: fromIntegral (number::Integer), and Int8 is a completely non-magical type. With your proposal, assume that the programmer makes a bunch of subtype declarations for his own types... What now? (Assuming that subtyping can be reasonably embedded in the Haskell's type system at all.) A more concrete example. Does 10 have type Int8 or Word8? Is Int8 a subtype of Word8, or the reverse? How could 10 be used as both Int8 and Word8? Current Haskell rules and not perfect: 12345::Int8 is legal. Conversions are explicit and there is no distinction between always safe conversions and those that may take an out of range parameter. But I'm happy with it; conversions are rarely used anyway, rules are simple, and there is no need of asking a question like: is every Int representable as Double (the answer may depend on the implementation). -- Marcin 'Qrczak' Kowalczyk From simonpj@microsoft.com Thu Oct 19 09:51:05 2000 From: simonpj@microsoft.com (Simon Peyton-Jones) Date: Thu, 19 Oct 2000 01:51:05 -0700 Subject: Num class Message-ID: <74096918BE6FD94B9068105F877C002D0110D002@red-pt-02.redmond.corp.microsoft.com> [I'm sending this reply to haskell-cafe. This one could run and run!] | > The defaulting mechanism works as follows: If there is an unresolved | > overloading error on a type variable a, which has as an *only* | > constraint (Num a), then we take a to be the suitable default. | | This is not what the Haskell 98 Report says. Section 4.3.4: | | "In situations where an ambiguous type is discovered, an ambiguous | type variable is defaultable if at least one of its classes is a | numeric class (that is, Num or a subclass of Num) and if all of its | classes are defined in the Prelude or a standard library (Figures 6--7 | show the numeric classes, and Figure 5 shows the classes defined in | the Prelude.)" | | I see no good reason for Show superclass of Num. Quite so. It's nothing to do with defaulting, and you could legitimately complain about it. | I agree that the default mechanism is ugly, and that at least the | restriction about classes defined in standard libraries should | be removed. This was quite a conscious decision by the Haskell committee. Defaulting decisions are made silently, and they affect the meaning of the program. So we consciously imposed quite heavy constraints to make sure that silent defaulting doesn't happen much. (GHC has a flag that warns you when it is happening.) You can always write your program by adding an explicit type signature. You can argue that this was a poor decision. Almost certainly there will be programs for which a more liberal choice would be much more convenient; perhaps Koen's is one. So I'm not trying to say "we got it right", only to explain why it is the way it is. Making Show a superclass of Num wasn't nearly as conscious a choice. Simon From Tom.Pledger@peace.com Thu Oct 19 11:16:18 2000 From: Tom.Pledger@peace.com (Tom Pledger) Date: Thu, 19 Oct 2000 23:16:18 +1300 (NZDT) Subject: Num class In-Reply-To: References: <14830.44367.723411.860256@waytogo.peace.co.nz> Message-ID: <14830.51698.582472.311903@waytogo.peace.co.nz> Marcin 'Qrczak' Kowalczyk writes: > On Thu, 19 Oct 2000, Tom Pledger wrote: > > > If you had such a non-standard type, I imagine you'd also declare > > something like this: > > > > instance Subtype Int8 Int16 where ... > > instance Subtype Int16 Int24 where ... > > instance Subtype Int24 Int where ... > > > > and hence literals in the range -128 to 127 would be typed Int8, etc. > > What would be the rule for typing integer literals? Currently it's > simple: fromIntegral (number::Integer), and Int8 is a completely > non-magical type. > > With your proposal, assume that the programmer makes a bunch of subtype > declarations for his own types... What now? > > (Assuming that subtyping can be reasonably embedded in the > Haskell's type system at all.) Of course! There's nothing quite like a nice flight of fancy. :-) A possible rule for typing integer literals is: intLitType x = tryToBeMoreSpecific (x `belongsTo`) IntegerT tryToBeMoreSpecific p t = case filter p (subtypes t) of [] -> t [t'] -> tryToBeMoreSpecific p t' ts -> case filter p (leastSpecificCommonSubtypes ts) of [t''] -> tryToBeMoreSpecific p t'' _ -> --ambiguity It's more complicated for the implementer, but makes things simpler for the programmer because we can then remove the Integral class and some unintuitive dualities like length/genericLength. > A more concrete example. Does 10 have type Int8 or Word8? Is Int8 a > subtype of Word8, or the reverse? How could 10 be used as both Int8 > and Word8? There should be no subtype relationship between Int8 and Word8 in either direction, because they denote different things: numbers and encodings respectively. We can say that every Int8 value *is* an Int16 value, but there is no reasonable corresponding statement about Int8 and Word8. Faced with the choice, I'd say that 10 looks like a number, and make it an Int8. If Word8 literals are required, as opposed to terms like fromEnum 10, they should have some other appearance like 10W. > Current Haskell rules and not perfect: 12345::Int8 is legal. Conversions > are explicit and there is no distinction between always safe conversions > and those that may take an out of range parameter. But I'm happy with it; > conversions are rarely used anyway, rules are simple, and there is no > need of asking a question like: is every Int representable as Double > (the answer may depend on the implementation). I'd be very cautious about putting Double into any subtype relationship at all, because its meaning is tied back into its representation. If you can't explain that "every X is a Y" without referring to representation issues, you shouldn't be declaring X as a subtype of Y! Admittedly I dodged your general comment and focussed on your example. I need to be more certain that subtyping is a feasible language extension, before I try to tell you what you should be happy with. :-) Regards, Tom From mk167280@students.mimuw.edu.pl Thu Oct 19 12:11:04 2000 From: mk167280@students.mimuw.edu.pl (Marcin 'Qrczak' Kowalczyk) Date: Thu, 19 Oct 2000 13:11:04 +0200 (CEST) Subject: Num class In-Reply-To: <14830.51698.582472.311903@waytogo.peace.co.nz> Message-ID: On Thu, 19 Oct 2000, Tom Pledger wrote: > = case filter p (subtypes t) of > [] -> t > [t'] -> tryToBeMoreSpecific p t' > ts -> case filter p (leastSpecificCommonSubtypes ts) of > [t''] -> tryToBeMoreSpecific p t'' > _ -> --ambiguity Why it is bad: - Adding a subtype elsewhere may make a program ambiguous. (Well, it is so with classes too, but at least it occurs only for overlapping instances, not unrelated subtypes of a generic type.) - Assuming that "more specific" means something like "subtype", types are usually put in some ordered sequences. This means that it is not enough for each type to know a basic framework, but it must also know a type just above or below it. When various types come from unrelated sources, it is unlikely that they will know one another in the right order. For example when we have sized integer types (Int8 etc.) and types that are mirrors of C types (CInt, CLong etc.), the sequence of subtypes is a mix of both families. Should both families know each other? When Posix types (CPid etc.) are added, they are again mixed. I can't imagine where all these subtyping instances would be defined. What is worse, whether CLong is smaller or larger than Int is implementation defined. Currently it does not prevent having an implementation independent set of instances. Conversion in both directions is explicit anyway, and literals just have the right type. With your proposal a type that wants to put itself at the right place in the sequence containing Int and CLong is in trouble. Of course some of these types could be defined as synonyms, but it's not necessarily a good idea in general. It would make correctness of a code dependent on the implementation, by not catching code that makes unportable assumptions about type equivalences. - When Int and CLong are isomorphic and thus declared subtypes of each other, wouldn't your proposal make the compiler loop? It's getting hairier and hairier. > It's more complicated for the implementer, but makes things simpler > for the programmer because we can then remove the Integral class and > some unintuitive dualities like length/genericLength. I doubt it's simpler fot the programmer. Certainly not simpler for me: I know how the current rules work but I don't know how subtyping could work :-) > There should be no subtype relationship between Int8 and Word8 in > either direction, because they denote different things: numbers and > encodings respectively. I hope we are not misunderstood. Word8 in GHC is an integer type representing values 0..255. It is definitely a number, in the same sense as Int8. Only their ranges are not contained in one another. > If Word8 literals are required, as opposed to terms like fromEnum 10, > they should have some other appearance like 10W. And you are saying that your proposal is less ugly than the current state? :-) > I'd be very cautious about putting Double into any subtype > relationship at all, because its meaning is tied back into its > representation. But people need to use floating point literals! Each Double is representable as Rational. Your proposal thus lets 0.125 be typed as Double, which can be implicitly coerced to Rational when needed. What about 0.1? It would lose precision when going to Rational through Double. OTOH it should definitely be allowed as a Double value too. How would you allow 0.1 to be used as either Rational or Double? > If you can't explain that "every X is a Y" without referring to > representation issues, you shouldn't be declaring X as a subtype of Y! That's why subtypes are not a right tool for typing numeric literals :-) (Assuming that they can fit Haskell at all.) -- Marcin 'Qrczak' Kowalczyk From mk167280@students.mimuw.edu.pl Thu Oct 19 12:24:28 2000 From: mk167280@students.mimuw.edu.pl (Marcin 'Qrczak' Kowalczyk) Date: Thu, 19 Oct 2000 13:24:28 +0200 (CEST) Subject: Num class In-Reply-To: Message-ID: On Thu, 19 Oct 2000, Marcin 'Qrczak' Kowalczyk wrote: > - Adding a subtype elsewhere may make a program ambiguous. (Well, it is so > with classes too, but at least it occurs only for overlapping instances, > not unrelated subtypes of a generic type.) For example adding two unrelated subtypes of Int16 disallows using 1234 as a value of type Integer! -- Marcin 'Qrczak' Kowalczyk From Tom.Pledger@peace.com Thu Oct 19 23:45:52 2000 From: Tom.Pledger@peace.com (Tom Pledger) Date: Fri, 20 Oct 2000 11:45:52 +1300 (NZDT) Subject: Num class In-Reply-To: References: <14830.51698.582472.311903@waytogo.peace.co.nz> Message-ID: <14831.31136.105443.526387@waytogo.peace.co.nz> Marcin 'Qrczak' Kowalczyk writes: > [...] > > Why it is bad: I appreciate your objections, and will bear them in mind, but if my hopes are going to be dashed, I'd rather it were done by one of the issues I see as bigger: - How can we infer types like `(0==) :: Subtype Int a => a -> Bool' ? - What is F^{omega}_{<=} and am I trying to reinvent it and what makes it so hard to implement? Feel free to call me a chicken for not answering your individual points... yet. :-) > [...] > > There should be no subtype relationship between Int8 and Word8 in > > either direction, because they denote different things: numbers and > > encodings respectively. > > I hope we are not misunderstood. Word8 in GHC is an integer type > representing values 0..255. It is definitely a number, in the same sense > as Int8. Only their ranges are not contained in one another. My mistake. Thanks for the clarification. > > If Word8 literals are required, as opposed to terms like fromEnum 10, > > they should have some other appearance like 10W. > > And you are saying that your proposal is less ugly than the current > state? :-) Joking aside, yes, it may make the overall state even more beautiful. Regards, Tom From pkot@ahoj.pl Wed Oct 25 09:48:57 2000 From: pkot@ahoj.pl (=?ISO-8859-2?Q? Pawe=B3?= Kot) Date: Wed, 25 Oct 2000 10:48:57 +0200 Subject: Haskell Programming Environment Message-ID: <20001025084900Z474423-538+2802@webmail1.ahoj.pl> Hello, I'm writing my master thesis. Its subject is 'Haskell Programming Environment'. It is (or rather will be) an extended text editor working in graphical (XFree86) environment designed for Haskell programmers. It will be implemented using Fudgets library. I'm wondering what features would you like to find in such environment. What should be neccessary, what would help, what would make writing programs easier, etc. I have some concepts, but I would like to hear some suggestions from you. Thanks for all answers. -- pkot -- mailto:pkot@linuxnews.pl http://newsreader.linuxnews.pl/ --- Przestań szukać. Zacznij znajdować. http://google.ahoj.pl From jans@numeric-quest.com Wed Oct 25 09:28:03 2000 From: jans@numeric-quest.com (Jan Skibinski) Date: Wed, 25 Oct 2000 04:28:03 -0400 (EDT) Subject: Haskell Programming Environment In-Reply-To: <20001025084900Z474423-538+2802@webmail1.ahoj.pl> Message-ID: On Wed, 25 Oct 2000, =?ISO-8859-2?Q? Pawe=B3?= Kot wrote: > Hello, > > I'm writing my master thesis. Its subject is 'Haskell Programming > Environment'. It is (or rather will be) an extended text editor working in > graphical (XFree86) environment designed for Haskell programmers. It will be > implemented using Fudgets library. > I'm wondering what features would you like to find in such environment. What > should be neccessary, what would help, what would make writing programs > easier, etc. > I have some concepts, but I would like to hear some suggestions from you. A module/class/instance/library browser perhaps? Acquiring its information from standard libraries and other user defined directories? Extracting comments, module comments, class comments, and implementation details to present them in some consistent way? Supporting incremental compilation, a'la hmake? With intelligent use of colorization, or other useful hints for programmers, for a start? Intelligent inspectors? In short - something that exists for ages in Smalltalk, or in Eiffel development environment, but with Haskell's extra capabilities, limitations and goals in view? I once did something of this sort for Java: + Java browser for Xcoral editor - in C + Bongo based class hierarchy browser - in Java You can find more about it on our web pages. Jan From Doug_Ransom@pml.com Wed Oct 25 17:03:43 2000 From: Doug_Ransom@pml.com (Doug Ransom) Date: Wed, 25 Oct 2000 09:03:43 -0700 Subject: Haskell Programming Environment Message-ID: <8E6C9AEA17A8D2118D6E00A0C998694001964A6C@hermes.pml.com> I would like to be able to inspect the type of things easily by hovering my mouse over an expression. As a beginner, I find it hard sometimes to get types correct in Haskell since often variables are not declared as a specific type. > -----Original Message----- > From: Jan Skibinski [mailto:jans@numeric-quest.com] > Sent: Wednesday, October 25, 2000 1:28 AM > To: Pawel Kot > Cc: haskell-cafe@haskell.org > Subject: Re: Haskell Programming Environment > > > > > On Wed, 25 Oct 2000, =?ISO-8859-2?Q? Pawe=B3?= Kot wrote: > > > Hello, > > > > I'm writing my master thesis. Its subject is 'Haskell Programming > > Environment'. It is (or rather will be) an extended text > editor working in > > graphical (XFree86) environment designed for Haskell > programmers. It will be > > implemented using Fudgets library. > > I'm wondering what features would you like to find in such > environment. What > > should be neccessary, what would help, what would make > writing programs > > easier, etc. > > I have some concepts, but I would like to hear some > suggestions from you. > > A module/class/instance/library browser perhaps? > Acquiring its information from standard libraries > and other user defined directories? Extracting comments, > module comments, class comments, and implementation > details to present them in some consistent way? Supporting > incremental compilation, a'la hmake? With intelligent use of > colorization, or other useful hints for programmers, > for a start? Intelligent inspectors? > > In short - something that exists for ages in Smalltalk, > or in Eiffel development environment, but with Haskell's > extra capabilities, limitations and goals in view? > > I once did something of this sort for Java: > + Java browser for Xcoral editor - in C > + Bongo based class hierarchy browser - in Java > You can find more about it on our web pages. > > Jan > > > > > > > > > > _______________________________________________ > Haskell-Cafe mailing list > Haskell-Cafe@haskell.org > http://www.haskell.org/mailman/listinfo/haskell-cafe > From lindig@eecs.harvard.edu Wed Oct 25 17:27:14 2000 From: lindig@eecs.harvard.edu (Christian Lindig) Date: Wed, 25 Oct 2000 12:27:14 -0400 Subject: Haskell Programming Environment In-Reply-To: <8E6C9AEA17A8D2118D6E00A0C998694001964A6C@hermes.pml.com>; from Doug_Ransom@pml.com on Wed, Oct 25, 2000 at 09:03:43AM -0700 References: <8E6C9AEA17A8D2118D6E00A0C998694001964A6C@hermes.pml.com> Message-ID: <20001025122714.H30032@lakeland.eecs.harvard.edu> On Wed, Oct 25, 2000 at 09:03:43AM -0700, Doug Ransom wrote: > I would like to be able to inspect the type of things easily by hovering my > mouse over an expression. As a beginner, I find it hard sometimes to get > types correct in Haskell since often variables are not declared as a > specific type. Since you are typically dealing with incomplete programs in an editor this is really tough. The PSG system was able to generate such editors and I once saw it for the purely functional language Sample in action: you could mark any term with the mouse cursor and ask for its type. -- Christian @Article{Bahlke:1986:PSG, author = "Rolf Bahlke and Gregor Snelting", title = "The {PSG} System: From Formal Language Definitions to Interactive Programming Environments", journal = "ACM Transactions on Programming Languages and Systems", volume = "8", number = "4", pages = "547--576", month = oct, year = "1986", coden = "ATPSDT", ISSN = "0164-0925", bibdate = "Sat Jan 06 09:41:04 1996", url = "http://www.acm.org/pubs/toc/Abstracts/0164-0925/20890.html", abstract = "The PSG programming system generator developed at the Technical University of Darmstadt produces interactive, language-specific programming environments from formal language definitions. All language-dependent parts of the environment are generated from an entirely nonprocedural specification of the language's syntax, context conditions, and dynamic semantics. The generated environment consists of a language-based editor, supporting systematic program development by named program fragments, an interpreter, and a fragment library system. The major component of the environment is a full-screen editor, which allows both structure and text editing. In structure mode the editor guarantees prevention of both syntactic and semantic errors, whereas in textual semantic analysis which is based on unification. The algorithm will immediately detect semantic errors even in incomplete program fragments. The dynamic semantics of the language are defined in denotational style using a functional language based on the lambda calculus. Program fragments are compiled to terms of the functional language which are executed by an interpreter. The PSG generator has been used to produce environments for Pascal, ALGOL 60, MODULA-2, and the formal language definition language itself.", acknowledgement = ack-pb # " and " # ack-nhfb, keywords = "algorithms; design; documentation; languages; theory; theory and verification and Hybrid editor and unification-based incremental semantic analysis; verification", owner = "manning", review = "ACM CR 8711-0926", subject = "{\bf D.3.4}: Software, PROGRAMMING LANGUAGES, Processors, Compilers. {\bf D.2.3}: Software, SOFTWARE ENGINEERING, Coding, Program editors. {\bf D.2.6}: Software, SOFTWARE ENGINEERING, Programming Environments. {\bf D.3.1}: Software, PROGRAMMING LANGUAGES, Formal Definitions and Theory, Semantics. {\bf D.3.1}: Software, PROGRAMMING LANGUAGES, Formal Definitions and Theory, Syntax. {\bf D.2.3}: Software, SOFTWARE ENGINEERING, Coding, Pretty printers. {\bf F.3.2}: Theory of Computation, LOGICS AND MEANINGS OF PROGRAMS, Semantics of Programming Languages. {\bf F.4.2}: Theory of Computation, MATHEMATICAL LOGIC AND FORMAL LANGUAGES, Grammars and Other Rewriting Systems, Grammar types. {\bf F.4.2}: Theory of Computation, MATHEMATICAL LOGIC AND FORMAL LANGUAGES, Grammars and Other Rewriting Systems, Parsing. {\bf I.2.3}: Computing Methodologies, ARTIFICIAL INTELLIGENCE, Deduction and Theorem Proving, Deduction.", } -- Christian Lindig Harvard University - DEAS lindig@eecs.harvard.edu 33 Oxford St, MD 242, Cambridge MA 02138 phone: +1 (617) 496-7157 http://www.eecs.harvard.edu/~lindig/ From Keith.Wansbrough@cl.cam.ac.uk Wed Oct 25 17:37:25 2000 From: Keith.Wansbrough@cl.cam.ac.uk (Keith Wansbrough) Date: Wed, 25 Oct 2000 17:37:25 +0100 Subject: Haskell Programming Environment In-Reply-To: Your message of "Wed, 25 Oct 2000 12:27:14 EDT." <20001025122714.H30032@lakeland.eecs.harvard.edu> Message-ID: > On Wed, Oct 25, 2000 at 09:03:43AM -0700, Doug Ransom wrote: > > I would like to be able to inspect the type of things easily by hovering my > > mouse over an expression. As a beginner, I find it hard sometimes to get > > types correct in Haskell since often variables are not declared as a > > specific type. > > Since you are typically dealing with incomplete programs in an editor > this is really tough. The PSG system was able to generate such > editors and I once saw it for the purely functional language Sample in > action: you could mark any term with the mouse cursor and ask for its > type. One of the emacs modes for Haskell gives the type of the identifier the cursor is in in the modeline. It does this by examining the type signatures in the current file, and having the prelude type signatures built-in. This is quite helpful, if incomplete, and fairly easy to implement. --KW 8-) -- Keith Wansbrough http://www.cl.cam.ac.uk/users/kw217/ Cambridge University Computer Laboratory. From hwloidl@cee.hw.ac.uk Wed Oct 25 18:02:47 2000 From: hwloidl@cee.hw.ac.uk (Hans Wolfgang Loidl) Date: Wed, 25 Oct 2000 18:02:47 +0100 Subject: Haskell Programming Environment In-Reply-To: Your message of "Wed, 25 Oct 2000 17:37:25 BST." Message-ID: Hi, > > On Wed, Oct 25, 2000 at 09:03:43AM -0700, Doug Ransom wrote: > > > I would like to be able to inspect the type of things easily by hovering my > > > mouse over an expression. As a beginner, I find it hard sometimes to get > > > types correct in Haskell since often variables are not declared as a > > > specific type. > > > > Since you are typically dealing with incomplete programs in an editor > > this is really tough. The PSG system was able to generate such > > editors and I once saw it for the purely functional language Sample in > > action: you could mark any term with the mouse cursor and ask for its > > type. > One of the emacs modes for Haskell gives the type of the identifier > the cursor is in in the modeline. It does this by examining the type > signatures in the current file, and having the prelude type signatures > built-in. This is quite helpful, if incomplete, and fairly easy to > implement. To increase its usefulness for multi-module programs, I have been planning for a long time to extract type info out of .hi files and feed it into the haskell-doc emacs module. Well, one day I may write an elisp parser to do that. In the meantime there is of course the possibility of pre-processing the Haskell source (or .hi) and feeding the type info as an elisp expression directly to haskell-doc. Here is the relevant bit from the docu: ;; If you want to define your own strings for some identifiers define an ;; alist of (ID . STRING) and set `haskell-doc-show-user-defined' to t. ;; E.g: ;; ;; (setq haskell-doc-show-user-defined t) ;; (setq haskell-doc-user-defined-ids ;; (list ;; '("main" . "just another pathetic main function") ;; '("foo" . "a very dummy name") ;; '("bar" . "another dummy name"))) Hope that helps, -- Hans Wolfgang From ahey@eptools.demon.co.uk Wed Oct 25 16:47:22 2000 From: ahey@eptools.demon.co.uk (Adrian Hey) Date: Wed, 25 Oct 2000 16:47:22 +0100 (BST) Subject: Haskell Programming Environment In-Reply-To: <20001025084900Z474423-538+2802@webmail1.ahoj.pl> Message-ID: Hello, On Wed 25 Oct, Pawe=B3 Kot wrote: > I have some concepts, but I would like to hear some suggestions from you. How about being able to type check partially written modules? Carlos Camarao posted a link to an implementation of type system CT in Haskell.. http://www.dcc.ufmg.br/~camarao/CT/CTinH.tar.gz Of course you don't really want to use a different type sytem from that currently used by Haskell. I believe this system makes use of 'principal typings' to infer the types of free variables from the context they are used, so it can be used to type check incomplete modules/programs. I can't think why such a system should be incompatible with the current Haskell typ= e system. It seems quite appropriate for an interactive development environment and should be able to give more intelligent error reports. Regards --=20 Adrian Hey From C.Reinke@ukc.ac.uk Wed Oct 25 18:49:30 2000 From: C.Reinke@ukc.ac.uk (C.Reinke) Date: Wed, 25 Oct 2000 18:49:30 +0100 Subject: Haskell Programming Environment In-Reply-To: Message from Keith Wansbrough of "Wed, 25 Oct 2000 17:37:25 BST." Message-ID: > One of the emacs modes for Haskell gives the type of the identifier > the cursor is in in the modeline. It does this by examining the type > signatures in the current file, and having the prelude type signatures > built-in. This is quite helpful, if incomplete, and fairly easy to > implement. Similar shortcuts are possible for other aspects, and might help to produce something useful within the constraints of an MSc project. Finding a reasonable compromise between producing something for an MSc and producing something that will remain in use and that others could build on later would be the first challenge, I think. Personally, I couldn't care less about yet another non-portable IDE demo bound to one specific, non-standard, smallish editor and one specific graphics library with one specific OS. It might get a small user base, but is likely to be out of date before it can grow to a functionality that could attract more users. But that's just my personal opinion.. The results of this survey and your own thoughts about what the specific issues in a Haskell Programming Environment might be, what functionality should be provided, and how, have a greater likelihood to be of lasting value. If you want to produce anything "real", you will want to reuse the language knowledge built into existing implementations. If you then want to remain portable, a good route would be to define an interface between the HPE and some Haskell implementation, specifying exactly which functionality the HPE would want to access, and how. Examples: - syntax-awareness. Experience with syntax-directed editors shows that users don't like to be locked into the syntax, they want some leeway for errors in intermediate stages. Also, many programmers don't want to drop their favourite, productive, proven and portable editor for the ones built into IDEs. Still, the editor should be aware of the syntax of the current language (those regular-expression-based syntax-highlighters are nothing but a stop-gap measure). Having a standard interface to the implementation's parser (where is the next subexpression? where is next enclosing context? where and what is the next syntax error?..). - scope&type awareness. A natural extension of the above with an interface to the implementation's symbol table (where is the binding occurence for this variable? what the type of this expression? what are the constructors/class instances for this type? which identifiers with which types are exported from this module?..) - other language-specific interactions. (evaluate current expression in current environment; browse module graph; browse class graph; compile&run; instrument for debugging;..) Have a look at the functionality provided in Hugs and try to define an interface that could support that functionality from within a standard editor, without being dependent on Hugs. There used to be an idea of having a more modular Haskell implementation with interfaces between all parts, including an interface between Hugs-like frontend and background compiler and runtime system (part of the Haskell Execution Platform, HEP;-). That got rescheduled to low priority, but might still be a useful starting point (http://www.haskell.org/ghc/docs/papers/hep.ps.gz). Of course, that would be only one side of a modular HPE. The other half would be to make sure that standard programmer editors (Emacs, VIM, ..) get the necessary stub functionality to make use of the interfaces. And finally, both Haskell implementers and Editor developers would need to be convinced to support those interfaces.. After that, implementing and adding functionality using the editor and implementation interfaces would be the lesser problem. The really good IDEs are either built on meta-programming and reflective facilities in the underlying programming language or integrated into one particular implementation. Trying to guess types and syntax is either a lot of work (duplicating what has gone into existing implementations) or just a hack. Claus From luti@linkexpress.com.br Wed Oct 25 23:25:34 2000 From: luti@linkexpress.com.br (Luciano Caixeta Moreira) Date: Wed, 25 Oct 2000 20:25:34 -0200 Subject: (no subject) Message-ID: <004f01c03ed2$9dc595c0$c55dfea9@servidor> This is a multi-part message in MIME format. ------=_NextPart_000_001F_01C03EC1.BA8BACA0 Content-Type: text/plain; charset="iso-8859-1" Content-Transfer-Encoding: quoted-printable unsubscribe luti@linkexpress.com.br ------=_NextPart_000_001F_01C03EC1.BA8BACA0 Content-Type: text/html; charset="iso-8859-1" Content-Transfer-Encoding: quoted-printable
unsubscribe=20 luti@linkexpress.com.br
------=_NextPart_000_001F_01C03EC1.BA8BACA0--