Erroneous warning

2001-09-17 Thread Ian Lynagh


If Q.lhs is

 module Q where

 foo :: Int - Int
 foo (i+1) = i
 foo 0 = -10

then

% ghc -c -o Q.o Q.lhs

Q.lhs:5: Warning: Pattern match(es) are overlapped in the definition of function `foo':
foo 0 = ...


Ian


___
Glasgow-haskell-bugs mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs



Re: Erroneous warning

2001-09-17 Thread moran

Ian Lynagh wrote:

 If Q.lhs is
 
  module Q where
 
  foo :: Int - Int
  foo (i+1) = i
  foo 0 = -10
 
 then
 
 % ghc -c -o Q.o Q.lhs
 
 Q.lhs:5: Warning: Pattern match(es) are overlapped in the definition of
 function `foo':
 foo 0 = ...

This is acceptbale behaviour, since the first equation can match with i = -1. 
The type is Int, not Nat.

Note that swapping the order of the equations gets rid of the warning. 
Morally, it shouldn't (since, in a perfect world, equation order shouldn't
matter), but it does in GHC because of the way pattern matching is compiled.
Maybe there should there be a warning in both cases, or not at all (the latter
being Hugs' behaviour).

Cheers,

Andy

-- 
Andy Moran  Ph.  (503) 526 3472
Galois Connections Inc. Fax. (503) 350 0833
3875 SW Hall Blvd.   http://www.galconn.com
Beaverton, OR 97005   [EMAIL PROTECTED]

___
Glasgow-haskell-bugs mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs



RE: Erroneous warning

2001-09-17 Thread Simon Marlow

 Ian Lynagh wrote:
 
  If Q.lhs is
  
   module Q where
  
   foo :: Int - Int
   foo (i+1) = i
   foo 0 = -10
  
  then
  
  % ghc -c -o Q.o Q.lhs
  
  Q.lhs:5: Warning: Pattern match(es) are overlapped in the 
 definition of
  function `foo':
  foo 0 = ...
 
 This is acceptbale behaviour, since the first equation can 
 match with i = -1. 
 The type is Int, not Nat.

Nope, (n+k) matches x when x = k.  In other words, n = 0.  The warning
is indeed wrong.

It's about time we started warning about *all* uses of n+k patterns, not
just the wrong ones.  n+k: Just Say No :-)

Cheers,
Simon

___
Glasgow-haskell-bugs mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs



Re: Erroneous warning

2001-09-17 Thread Malcolm Wallace

  foo :: Int - Int
  foo (i+1) = i
  foo 0 = -10

 Q.lhs:5: Warning: Pattern match(es) are overlapped in the definition of
 function `foo':
 foo 0 = ...

| This is acceptbale behaviour, since the first equation can match with i = -1. 
| The type is Int, not Nat.

No, it is not acceptable according to the Haskell'98 Report, section
3.17.2, rule 4(c).  N+k patterns can only match positive ints.
That non-symmetry is one of the reasons many people would like to
get rid of this pattern form.

Regards,
Malcolm

___
Glasgow-haskell-bugs mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs



Re: Erroneous warning

2001-09-17 Thread Ian Lynagh

On Mon, Sep 17, 2001 at 12:52:32PM +0100, Ian Lynagh wrote:
 
 Q.lhs:5: Warning: Pattern match(es) are overlapped in the definition of function 
`foo':
 foo 0 = ...

Oh, along similar lines, should the warning not be
Pattern match(es) are hidden in [...]
or similar? Overlapping patterns are OK, e.g.

 foo 5 = 0
 foo _ = 2

but the problem comes when they are the other way round so the first one
hides the second.


Ian


___
Glasgow-haskell-bugs mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs



Re: NEw Install Shield Borage Thungg working on win 2000

2001-09-17 Thread Yeo Gek Hui

 I am not quite sure what you mean ghc will only work at the bin
 directory. Do you mean that you can only compile files when you are
 in the bin directory? Have you added ghc's bin directory to your PATH?

Yes, I have added the bin directory to my PATH and yet ,I can only compile
files when I am in the bin directory. So, is there an alternative to
resolve this problem?
Thank you so much.
Regards,
Gek



___
Glasgow-haskell-bugs mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs



Re: NEw Install Shield Borage Thungg working on win 2000

2001-09-17 Thread Reuben Thomas

  I am not quite sure what you mean ghc will only work at the bin
  directory. Do you mean that you can only compile files when you are
  in the bin directory? Have you added ghc's bin directory to your PATH?
 
 Yes, I have added the bin directory to my PATH and yet ,I can only compile
 files when I am in the bin directory. So, is there an alternative to
 resolve this problem?

What error message do you get when you try to compile elsewhere?

-- 
http://sc3d.org/rrt/ | The only person worth beating is yourself

___
Glasgow-haskell-bugs mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs



I WILL TEACH YOU TO HAVE SEX - MY CAN IS ON FOR YOU

2001-09-17 Thread ANNA

Below is the result of your feedback form.  It was submitted by ANNA 
([EMAIL PROTECTED]) on Monday, September 17, 19101 at 15:22:13
---

message: Hello my friend
My cam is always on for you.for your sex
I cannot forget all the words that you told me last saturday
while my wet pussy was open for you.
Now you can connect to my CAM directly from my home page
http://www.freebox.com/livesex
I will teach you how to do. I have a new software for that.
You'll find me nude waiting you.
Don't leave me alone without you
Anna














---

___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



RE: unsafePtrCompare, anybody?

2001-09-17 Thread Simon Marlow

 I'm writing an atom table for a compiler/interpreter, and it 
 would be really 
 nice to use unsafePtrLT to implement tree-based finite maps.  
 
 For clarification, my atom table consists  of these three functions: 
 
 mkAtom :: String - IO Atom
 show  :: Atom - String
 (==)  :: Atom - Atom - Bool
 
 such that   
   mkAtom s = (return . show) == return s
 and
   mkAtom . show == return
 and 
   atom == atom'  =  show atom == show atom' 
 
 mkAtom looks up each string in a table stored in an global 
 variable, and 
 returns the atom stored in the table if it is there.  
 Otherwise, it makes the 
 string into an atom, inserts the atom into the table, and 
 returns this new 
 atom.
 
 The point of all of this is that now string equality, when 
 strings are made 
 into atoms, is just pointer equality, which is available as 
 IOExts.unsafePtrEq.

You might want to check out GHC's FastString module, which does
essentially this.  We use an explicit hash table, and each FastString
has a unique Id for fast comparison.

To solve your immediate problem, you could also take a look at the
StableName library, which lets you map any old Haskell value on to an
Int so you can build finite maps etc. (we use StableNames to build memo
tables).  There's a small garbage collector overhead for this, though.

 Of course, the misuses of unsafePtrEq aren't nearly as 
 heinous as those of 
 unsafePtrCompare.   On the other hand, it might be next to 
 impossible to 
 effectively use unsafePtrCompare in cases that it isn't 
 completely safe to 
 use, whereas there are plently of situations where 
 unsafePtrEq is semi-safe 
 to use.

I can't think of a way to use unsafePtrCompare safely :-)  The relative
ordering of objects isn't guaranteed to be stable under GC.

Cheers,
Simon

___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



Re: unsafePtrCompare, anybody?

2001-09-17 Thread Carl R. Witty

Leon Smith [EMAIL PROTECTED] writes:

 However, in this situation, pointer comparison is simply an arbitrary total 
 order on the set of all atoms, which is all we need to implement finite maps 
 based on search trees.  And of course, pointer comparisons are a much cheaper 
 operation that actual string comparison.

You could just add an extra Int sequence number to your Atoms, and
compare using that.

Carl Witty

___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



Re: unsafePtrCompare, anybody?

2001-09-17 Thread Leon Smith

 I can't think of a way to use unsafePtrCompare safely :-)  The relative
 ordering of objects isn't guaranteed to be stable under GC.

 Cheers,
   Simon

Doh,  that would throw a monkey wrench into things, wouldn't it?   I know of 
compacting GC algorithms, but I didn't consider that GHC might be using one.  
At least I am now more enlightened on the inner workings of the magic beast...

I've considered many of the other implementation options, but as it isn't 
essential to the working of the compiler,  it hasn't been a priority yet.  It 
simply struck me that this would be a particularly quick and easy way to 
implement reasonably good atom tables, only requiring a newtype declaration 
and a few very simple function definitions.   

Thanks to Simon for saving me from reinventing the wheel.   The libraries 
mentioned here should prove to be quite useful.  

One's intuition would suggest that you could be safely implement mkAtom 
without wrapping it in a IO monad.   After all, at least at a abstract level, 
an atom table is referentially transparent.  The library documentation says 
that lack of side effects and environmental independance is sufficent to 
order for uses of unsafePerformIO to be safe.  Is there a exact (or at least 
better) criterion for safety?   

unsafePerformIO is used in the implementation of mkFastString, so how is 
it's side effects safe.   I experimented with unsafePerformIO with my Atom 
table, but I could not get tthe code to work properly.

best,
leon

___
Glasgow-haskell-users mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-users



RE: The future of Haskell discussion

2001-09-17 Thread Simon Marlow

Jeffrey Palmer writes:
 I think the question is more along the lines of Why doesn't Haskell
 come bundled with complete, useful and _supported_ libraries?

There's an ongoing effort to rectify the situation.  There is a mailing
list: [EMAIL PROTECTED], which you can join by going to 

http://www.haskell.org/mailman/listinfo/libraries

(there are archives of previous discussion there too).  A draft document
describes the current plan:

http://www.haskell.org/~simonmar/libraries/libraries.html

and what source code we have so far is in CVS:

http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/libraries/

Cheers,
Simon

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



PEPM'02: Final Call for Papers

2001-09-17 Thread Peter Thiemann

FINAL CALL FOR PAPERS

 2002 ACM SIGPLAN Workshop on
Partial Evaluation and Semantics-Based Program Manipulation (PEPM'02)
  Portland, Oregon, USA, January 14-15, 2002
 (preceding POPL'02)
http://www.informatik.uni-freiburg.de/~thiemann/pepm02

Submission deadline: 8 October, 2001

The PEPM'02 workshop will bring together researchers working in the
areas of semantics-based program manipulation, partial evaluation, and
program generation. The workshop focuses on techniques, supporting
theory, and applications of the analysis and manipulation of programs.
Technical topics include, but are not limited to:

* Program manipulation techniques: transformation, specialization,
  normalization, reflection, rewriting, run-time code generation,
  multi-level programming.  

* Program analysis techniques: abstract interpretation, static
  analysis, binding-time analysis, attribute grammars, constraints. 

* Related issues in language design and models of computation:
  imperative, functional, logical, object-oriented, parallel,
  distributed, mobile, secure, domain-specific. 

* Programs as data objects: staging, meta-programming, incremental
  computation, mobility, tools and techniques, prototyping and
  debugging. 

* Applications: systems programming, scientific computing,
  algorithmics, graphics, security checking, simulation, compiler
  generation, compiler optimization, decompilation. 

* Assessment: applicability of program manipulation techniques to
  particular architectures and language paradigms, scalability,
  benchmarking, portability. 

Original results that bear on these and related topics are solicited.
Papers investigating novel uses and applications of program
manipulation in the broadest sense are especially encouraged.  Authors
concerned about the appropriateness of a topic are welcome to consult
with the program chair prior to submission.

SUBMISSION INFORMATION

Papers should be submitted electronically via the workshop's Web 
page. Exceptionally, submissions may be emailed to the program
chair: URL:mailto:[EMAIL PROTECTED]. Acceptable
formats are PostScript or PDF, viewable by gv. 
Submissions should not exceed 5000 words, excluding bibliography and
figures. Excessively long submissions may be rejected outright. 

Submitted papers will be judged on the basis of significance,
relevance, correctness, originality, and clarity. They should include
a clear identification of what has been accomplished and why it is
significant. They must describe work that has not previously been
published in a major forum. Authors must indicate if a closely
related paper is also being considered for another conference or
journal.

Proceedings will be published with ACM Press. A special issue of the
journal Higher-Order and Symbolic Computation
URL:http://www.wkap.nl/journals/lasc is planned afterwards. 

PROGRAM COMMITTEE

Maria Alpuente  (U. Politécnica de Valencia, Spain)
Evelyn Duesterwald  (Hewlett-Packard Labs, USA)
Robert Glück(DIKU, Denmark and Waseda University, Japan)
Michael Hanus   (Christian-Albrecht-University of Kiel, Germany)
Zhenjiang Hu(University of Tokyo, Japan)
John Hughes (Chalmers Technical University, Sweden)
Mark Jones  (OGI, USA)
Siau-Cheng Khoo (NUS, Singapore)
Jakob Rehof (Microsoft Research, USA)
João Saraiva(University of Minho, Portugal)
Ulrik Schultz   (University of Aarhus, Denmark)
Peter Thiemann  (University of Freiburg, Germany, chair)
David Walker(CMU, USA)

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



Re: The future of Haskell discussion

2001-09-17 Thread Yoann Padioleau

Alastair David Reid [EMAIL PROTECTED] writes:

 In the case of the Draw monad (which is identical to the
 IO monad except that it carries a device context around as an
 implicit parameter), the different feel comes from aggressive
 use of continuations (actually, they're not quite continuations
 but I don't have a better word for them).  For example, you might
 normally write code like this:
 
   do
 old_color - selectColor blue
 old_font  - selectFont  helvetica
 write_text Hello World
 selectFont  old_font
 selectColor old_color
 
 (Reselecting the old color and font at the end is recommended Win32
 programming style.)
 
 In the HGL, you instead write:
 
   setPicture window (withColor blue (withFont helvetica (text Hello World)))

you can achieve the same in many langage such as c++. 
I dont really see what is haskell specific in your code.

pseudo code (i dont remember exactly c++ :) ):

class Draw {
 Color color;
 Font  font;
 Widget wid;
 
 Draw(Widget w) { wid = w }
 draw(window) { Color old; Font old;  
oldc = setColor color; oldf = setFont font; 
wid.draw(window);
setColor oldc; setFont oldf;
   }  
 withColor (Color c) {color = c}
 withFont  (Font f)  {font = f}
}

new Draw(new textWidget(Hello 
World))-withColor(blue)-withFont(helvetica)-draw(window)
   
there are plenty of way to achieve what you do.

 
 or, equivalently but allegedly easier to read,
 
   setPicture window$
 withColor blue $
 withFont helvetica $
 text Hello World
 
 where withColor and withFont are defined like this:
 
   withColor :: Color - Draw a - Draw a
   withColor c m = do{ old - selectColor c; a - m; selectColor old; return a }
 
   withFont  :: Font  - Draw a - Draw a
   withFont f m = do{ old - selectFont f; a - m; selectFont old; return a }
 
 and setPicture exploits the fact that an object of type Draw a is a
 first class object which can be stored in the window state and
 executed when appropriate (e.g., when the window is uniconified).
 
 
 What I'm saying is that Haskell's standard abstraction facilities mean
 that even in the IO monad your programming experience can
 significantly better than that of a C programmer.  (Of course your
 experience can also be worse if you don't or can't bring Haskell's
 strengths to bear on your problem.)

-- 
Yoann  Padioleau,  INSA de Rennes, France,   http://www.irisa.fr/prive/padiolea
Opinions expressed here are only mine. Je n'écris qu'à titre personnel.
**   Get Free. Be Smart.  Simply use Linux and Free Software.   **

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



Subscribe

2001-09-17 Thread John Miller












ProClarity Corporation

John Miller

Research  Development

[EMAIL PROTECTED]

(208)344-1630 ext. 111










Re: Application letters at the Haskell workshop: suggestion

2001-09-17 Thread Alastair David Reid


Marcin 'Qrczak' Kowalczyk [EMAIL PROTECTED] writes:
 Parsec [uses some variant of the error monad] and similar things. It
 tries to generate reasonable messages of the form expecting foo,
 found bar or unexpected bar annotated with source position,
 making use of labels of higher level syntactic constructs inserted
 in the grammar as well as individual characters matched.

I think this illustrates an important point about different approaches
to exception handling.

Parsing is a great example of where error monads are useful:

1) You expect the errors to be the common case instead of the
   very unlikely case (so you're willing to expend quite a bit
   of effort to handle them well).

   Typecheckers also fit into this category.

2) You really care about what the error message looks like.

3) Your code is either all machine generated (e.g., by happy)
   or you use combinators (e.g., = and return) so it is easy
   to thread the error monad through and to be consistent about
   doing it.

In these case, I think error monads are the best choice.

The Hugs/GHC exception catching that Andy Moran described is aimed at
situations where these don't apply.  Cases include:

1) Your program has to manipulate some real world (and stateful)
   object and it is not considered acceptable to leave it in some
   confused state.  Examples include leaving windows open when a GUI
   equipped program crashes, a control system (like the joystick in a
   plane or controls in a lift) that suddenly stops responding, leaving
   a database in an inconsistent state, etc.

2) You write a library (e.g., Fran, HGL, etc.) where (hopefully)
   carefully written library code (which can be as full of error 
   checks as you want) has to invoke user code and, somehow, recover
   and, either keep going or shut down cleanly.

3) Someone gives you a great library but their code doesn't use the
   error monad (or whatever) because the code was developed for a
   less demanding execution environment.  The library is large and
   rewriting it is daunting.

4) You think you've used the error monad consistently and avoided
   calling all those unsafe Prelude functions like head, tail,
   minimum, and div but you've got no good way of checking and
   you want your code to be robust.

5) You really don't care much which exception you get - as long
   as you get one.

I think the two approaches complement each other rather well (but, of
course, I'm biased...).

-- 
Alastair Reid[EMAIL PROTECTED]http://www.cs.utah.edu/~reid/

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



Subscribe

2001-09-17 Thread John Miller












ProClarity Corporation

John Miller

Research  Development

[EMAIL PROTECTED]

(208)344-1630 ext. 111