Bug in hGetBufBA + hIsEOF

2001-12-10 Thread Koen Claessen

Hi,

Given a file test of size 2342.

The program Bug.hs behaves correctly (the result is
(2048,384)), but when uncommenting the seemingly innocent
line, the program behaves incorrectly (result is
(2048,2048)), and the buffer is filled with garbage.

main =
  do han - openFile test ReadMode
 arr - stToIO (newCharArray (0,2048))
 n1  - hGetBufBA han arr 2048
 --eof - hIsEOF han
 n2  - hGetBufBA han arr 2048
 print (n1,n2)

I am using solaris and GHC 5.02.1.

Thanks,
/Koen.


module DataStream where

import IO
import IOExts
import MutableArray
import ST
import GlaExts

main =
  do dat - readFileData DataStream.hs
 writeFileData copy.hs dat


-- Data

newtype Data = MkData [(Int,MutableByteArray RealWorld Int)]


-- reading, writing

hGetData :: Handle - IO Data
hGetData han =
  do xs - get
 return (MkData xs)
 where
  get =
unsafeInterleaveIO (
  do arr - stToIO (newCharArray (0,blockSize))
 putStrLn Reading ...
 n   - hGetBufBA han arr blockSize
 putStrLn ((read  ++ show n ++  bytes))
 --eof - hIsEOF han
 let eof = n /= blockSize
 xs  - if eof then return [] else do hIsEOF han; get
 return ((n,arr):xs)
)

hPutData :: Handle - Data - IO ()
hPutData han (MkData xs) =
  sequence_ [ do hPutBufBA han arr n
 putStrLn ((written  ++ show n ++  bytes))
| (n,arr) - xs ]

blockSize :: Int
blockSize = 2048


-- files

readFileData :: FilePath - IO Data
readFileData file =
  do han - openFile file ReadMode
 hGetData han

writeFileData :: FilePath - Data - IO ()
writeFileData file dat =
  do han - openFile file WriteMode
 hPutData han dat
 hClose han

appendFileData :: FilePath - Data - IO ()
appendFileData file dat =
  do han - openFile file AppendMode
 hPutData han dat
 hClose han

{-

-- operations

toData :: String - Data
toData s =
  unsafePerformST (
do arr - newCharArray (0,n)
   sequence_ [ writeCharArray arr i c | (i,c) - [0..] `zip` s ]
   return (MkData [(n,arr)])
  )
 where
  n = length s - 1

fromData :: Data - String
fromData (MkData xs) =
  concat (unsafePerformST (sequence [ read n arr | (n,arr) - xs ]))
 where
  read n arr =
sequence [ readCharArray arr i | i - [0..n] ]

(+++) :: Data - Data - Data
MkData xs +++ MkData ys = MkData (xs ++ ys)


-- helpers

unsafePerformST :: ST RealWorld a - a
unsafePerformST m = unsafePerformIO (stToIO m)
-}

-- the end.



module Main where

import IO
import IOExts
import MutableArray
import ST
import GlaExts

main =
  do han - openFile test ReadMode
 arr - stToIO (newCharArray (0,2048))
 n1  - hGetBufBA han arr 2048
 --eof - hIsEOF han
 n2  - hGetBufBA han arr 2048
 print (n1,n2)


 
 





RE: Bug in hGetBufBA + hIsEOF

2001-12-10 Thread Simon Marlow


 Given a file test of size 2342.
 
 The program Bug.hs behaves correctly (the result is
 (2048,384)), but when uncommenting the seemingly innocent
 line, the program behaves incorrectly (result is
 (2048,2048)), and the buffer is filled with garbage.
 
 main =
   do han - openFile test ReadMode
  arr - stToIO (newCharArray (0,2048))
  n1  - hGetBufBA han arr 2048
  --eof - hIsEOF han
  n2  - hGetBufBA han arr 2048
  print (n1,n2)
 
 I am using solaris and GHC 5.02.1.

Thanks, that's a bug.  Workaround: hGetBufBA will only return a value
less than the specified count if EOF is reached, so you can detect EOF
that way.

Cheers,
Simon

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



Re: --+ not treated as a start of a comment

2001-12-10 Thread Sigbjorn Finne

Thanks, I've made Hugs98 comply with the Report.

--sigbjorn

- Original Message - 
From: Ian Lynagh [EMAIL PROTECTED]
To: [EMAIL PROTECTED]
Sent: Sunday, December 09, 2001 10:43
Subject: --+ not treated as a start of a comment


 
 If I have
 
 foo = 0 --+ 1
 
 then ghc tells me
 
 tt.lhs:2: Variable not in scope: `--+'
 
 while the report (and hugs) believe --+ 1 is a comment.
 
 
 Thanks
 Ian
 
 
 ___
 Glasgow-haskell-bugs mailing list
 [EMAIL PROTECTED]
 http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs


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



RE: Combining Module Interfaces

2001-12-10 Thread Simon Peyton-Jones

No, GHC just does not support this.  GHC tries to avoid duplicating 
information (which might become inconsistent with catastrophic results),

so C.hi simply records the dependency on A.hi and B.hi.
You must have both of the latter available.

Simon

| -Original Message-
| From: Ashley Yakeley [mailto:[EMAIL PROTECTED]] 
| Sent: 07 December 2001 22:03
| To: GHC List
| Subject: Combining Module Interfaces
| 
| 
| Is there a way to combine interfaces into a single file?
| 
| If I have modules A and B, I want to create a module C with all the 
| exported definitions of A and B such that I can compile 
| against C.hi file 
| without needing the A.hi and B.hi files.
| 
| I tried this:
| 
| module C (module A,module B) where
|  {
|  import A;
|  import B;
|  }
| 
| ...but if I attempt to compile against C.hi using definitions 
| from A and 
| B, GHC complains if I don't have A.hi and B.hi. I want C.hi 
| to contain 
| everything that A.hi and B.hi do.
| 
| -- 
| Ashley Yakeley, Seattle WA
| 
| 
| ___
| Glasgow-haskell-users mailing list 
| [EMAIL PROTECTED] 
| http://www.haskell.org/mailman/listinfo/glasgow-| haskell-users
| 

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



RE: Questions about sharing

2001-12-10 Thread Simon Marlow

 My understanding is that GHC tries to have it both ways.  Here's my
 understanding of how it works (implementors should probably chime in
 if my memory is faulty or out of date):
 
 1) There is a single, canonical copy of every nullary constructor.
   This canonical copy is used wherever possible---just like a
   top-level constant.
 
 2) Updating a thunk with an indirection makes it expensive to obtain
   the thunk's value.  The extra indirection does not require
   allocation---the only reason we need indirections at all is to
   overwrite memory that previously held a thunk.  The real problem is
   that it takes time to chase down indirections once they exist.
 
   Therefore when a thunk evaluates to a nullary constructor, it is
   overwritten directly.  This effectively creates another copy of the
   nullary constructor.
 
 3) When the GC runs, instead of copying these newly-created nullary
   constructors, it replaces them with the canonical copy.
 
   [The GC also eliminates indirections, and thus helps us no matter
   what we do in 2) above]

Actually we don't do (2) and (3) - update in place only happens in very
limited conditions nowadays, namely when we know we're returning to an
update frame and the constructor being returned is not nullary and also
has no pointer fields (the latter restriction is to avoid complications
due to generational GC).

In The Olden Days (= 3.02) we used a return-in-registers policy to
avoid heap-allocating return values when they were about to be used once
and thrown away, and this also enabled update-in-place in certain
circumstances.  However the whole thing was terribly complicated to
implement, so now we have standard heap returns but we also do analysis
(previously CPR analysis, now incorporated into the new demand analysis)
to discover when a value can be returned on the stack instead of the
heap.

Cheers,
Simon

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



CFP: WRS 2002 - 2nd WS on Reduction Strategies in Rewriting and Programming

2001-12-10 Thread Bernhard Gramlich


   [Apologies for multiple copies of this announcement]

**
*** first  call for papers and participation  
**

Second International Workshop on Reduction Strategies 
   in Rewriting and Programming (WRS 2002)

   http://www.dsic.upv.es/users/elp/WRS2002
   
 held in conjunction with RTA 2002
 Copenhagen, Denmark, July 21, 2002

--

BACKGROUND AND AIMS

Reduction strategies in rewriting and programming have attracted an
increasing attention within the last years. New types of reduction
strategies have been invented and investigated, and new results on
rewriting / computation under particular strategies have
been obtained. Research in this field ranges from primarily theoretical
questions about reduction strategies to very practical application and
implementation issues. The need for a deeper understanding of reduction
strategies in rewriting and programming, both in theory and practice,
is obvious, since they bridge the gap between unrestricted general
rewriting (computation) and (more deterministic) rewriting with
particular strategies (programming). Moreover, reduction strategies
provide a natural way to go from operational principles (e.g., graph
and term rewriting, narrowing, lambda-calculus) and semantics (e.g.,
normalization, computation of values, infinitary normalization,
head-normalization) to implementations of programming languages. 

Therefore any progress in this area is likely to be of interest not
only to the rewriting community, but also to neighbouring fields like
functional programming, functional-logic programming, and termination
proofs of algorithms.  

The workshop wants to provide a forum for the presentation and
discussion of new ideas and results, recent developments, new research
directions, as well as of surveys on existing knowledge in this
area. Furthermore we aim at fostering interaction and exchange between
researchers and students actively working on such topics. 
The workshop will be held in conjunction with RTA 2002 in Copenhagen 
(Denmark) on July 21, 2002. 

The workshop is (co-)organized by TU Valencia and TU Wien.


TOPICS OF INTEREST

Topics of interest include, but are not restricted to,  
- theoretical foundations for the definition and semantic description 
  of reduction strategies
- strategies in different frameworks (term rewriting, graph rewriting,
  infinitary rewriting, lambda calculi, higher order rewriting and 
  explicit substitutions, conditional rewriting, rewriting with 
  built-ins, narrowing, constraint solving, etc.) and their application 
  in (equational, functional, functional-logic) programming (languages)
- properties of reduction strategies / computations under
  strategies (e.g., completeness, computability, decidability,
  complexity, optimality, (hyper-)normalization, cofinality,
  fairness, perpetuality, context-freeness, neededness, laziness,
  eagerness, strictness)
- interrelations, combinations and applications of
  reduction under different strategies (e.g., equivalence
  conditions for fundamental properties like termination and
  confluence, applications in modularity analysis, connections
  between strategies of different frameworks, etc.)
- program analysis and other semantics-based optimization techniques
  dealing with reduction strategies
- rewrite systems / tools / implementations with flexible /
  programmable strategies as essential concept / ingredient
- specification of reduction strategies in (real) languages
- data structures and implementation techniques for reduction
  strategies.


SUBMISSIONS

We solicit papers on all aspects of reduction strategies in
rewriting and programming. Submissions should describe unpublished
work, except for survey papers which are explicitly welcome,
too. Submissions should not exceed 10 pages (however, survey papers
may be longer) and be sent in postscript format to the PC co-chairs
to the following e-mail address:

  [EMAIL PROTECTED] 
   
before April 15, 2002. Submissions should include the title, authors'
names,  affiliations, addresses, and e-mail. Selection of papers by 
the PC will be based on originality, significance, and correctness. 
Accepted papers will be included in the workshop proceedings that 
will be available at the workshop, and electronically on the web.
Final versions will be due by June 17, 2002. 


PUBLICATION

Accepted papers will be included in the workshop proceedings that 
will be available at the workshop, and electronically on the web. 
A special issue of the Journal of Symbolic Computation on

   Reduction Strategies in Rewriting and Programming

will be designated for revised and extended versions of selected 
contributions from both 

Another question about sharing

2001-12-10 Thread Adrian Hey

Hello,

If I have..
data Path = L Path | R Path | T
paths = T : branch paths
branch (p:ps) = L p : R p : branch ps

This will be a CAF which can never be garbage collected, but
may grow indefinitely large as it gets reduced. Correct?

Is it possible to avoid this problem somehow? What I have
in mind is a special thunk which get's copied (as a normal
thunk) before it gets reduced. Pointer references are
preserved during copying, except self referential pointers,
which are updated to point to the new thunk.

Alternatively..
I had thought maybe a function with a dummy argument
like this would do..
paths x = let paths' = T : branch paths'
  in  paths'
But the paths' will just be lambda lifted as a CAF
(I believe)

This seems to solve the lambda lifting problem..
paths x = T : branch (paths x)
but I'm not sure how compilers will treat this.
I think I'll also loose the sharing of earilier
paths in new paths, unless the compiler optimises
the self reference.

If I redefined my datatype..
data Path x = L (Path x) | R (Path x) | T x
I could then use the function with dummy argument
solution..
paths x = let paths' = T x : branch paths'
  in  paths'
This seems to solve both problems, but there's
yet another problem I anticipate..

When using any of these dummy argument solutions
I have to make sure the argument is not a constant (or
I'm back to the lambda lifting problem again). So it
has to be any handy unknown variable (argument)?
This presents the problem that the unknown variable
may itself be quite large, and have it's lifetime
unduly prolonged because it's now referenced by
many paths.

Any advice?

Thanks
-- 
Adrian Hey


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



Re: Another question about sharing

2001-12-10 Thread Malcolm Wallace

 If I have..
   data Path = L Path | R Path | T
   paths = T : branch paths
   branch (p:ps) = L p : R p : branch ps
 
 This will be a CAF which can never be garbage collected, but
 may grow indefinitely large as it gets reduced. Correct?

Any decent compiler will garbage collect the CAF when it is no
longer needed.  However, this does not solve the problem that the
CAF could grow very large whilst its value is still required.

Regards,
Malcolm

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



WAAAPL 2002, preliminary announcement

2001-12-10 Thread Ralf Hinze

Apologies if you receive multiple copies...



 PRELIMINARY CALL FOR PAPERS

   [Deadline for submission: 3rd June 2002]

 WAAAPL 2002

 Workshop on
Algorithmic Aspects of Advanced Programming Languages

  Part of PLI'02 (approval pending)
 Pittsburgh, PA, USA
 date to be announced (probably Oct 7 or Oct 8, 2002)

http://www.cs.uni-bonn.de/~ralf/waaapl02.{html,pdf,ps,dvi,txt}



Scope
-

WAAAPL (pronounced wapple) seeks papers on all aspects of the
design, analysis, evaluation, or synthesis of algorithms or data
structures in the context of advanced programming languages, such as
functional or logic languages, where traditional algorithms or data
structures may be awkward or impossible to apply. Possible topics
include (but are not limited to):

  o  new algorithms or data structures,
  o  empirical studies of existing algorithms or data structures,
  o  new techniques or frameworks for the design, analysis,
 evaluation, or synthesis of algorithms or data structures,
  o  applications or case studies,
  o  pedagogical issues (language aspects of teaching algorithms or
 algorithmic aspects of teaching languages).

A previous WAAAPL workshop has been held in Paris (1999).

Submission details
--

Deadline for submission:3rd June 2002
Notification of acceptance: 1st July 2002
Final submission due:   1st August 2002
WAAAPL Workshop:to be announced (probably Oct 7 or Oct 8, 2002)

Authors should submit papers of at most 12 pages, in postscript
format, formatted for A4 paper, to Ralf Hinze ([EMAIL PROTECTED]) or
Chris Okasaki ([EMAIL PROTECTED]) by 3rd June 2002.  The
accepted papers will be published as a University of Bonn technical
report.

Programme committee
---

Richard Bird  Oxford University
Michael Hanus University of Kiel
Ralf HinzeUniversity of Bonn (co-chair)
Zhenjiang Hu  University of Tokyo
Haim Kaplan   Tel Aviv University
Chris Okasaki United States Military Academy (co-chair)
Melissa O'Neill   Harvey Mudd College



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



FME'2002, 2nd CFP

2001-12-10 Thread Lars-Henrik Eriksson

apologies if you receive multiple copies...


  FORMAL METHODS EUROPE

   FME 2002
   Formal Methods: Getting IT Right

  International Symposium and Tutorials
   http://floc02.diku.dk/FME/
20-24 July 2002

  Second Call for Papers
  **

FME 2002 is the eleventh in a series of symposia organised by Formal
Methods Europe, an independent association whose aim is to stimulate the
use of, and research on, formal methods for software development. These
symposia have been notably successful in bringing together a community of
users, researchers, and developers of precise mathematical methods for
software development. In 2002 the symposium will be held in conjunction
with the third Federated Logic Conference (FLoC'02) in Copenhagen, Denmark.

The theme of FME 2002 is Formal Methods: Getting IT Right.

The double meaning is intentional. On the one hand, the theme acknowledges
the significant contribution formal methods can make to Information
Technology, by enabling computer systems to be described precisely and
reasoned about with rigour. On the other hand, it recognises that current
formal methods are not perfect, and further research and practice are
required to improve their foundations, applicability and effectiveness.

FME seeks papers in all aspects of formal methods for computer systems,
including the following:

 * theoretical foundations
 * practical use and case studies
 * specification and modelling techniques
 * software development and refinement
 * tool support and software engineering environments for formal methods
 * verification and validation
 * hidden formal methods, and making benefits available to non-experts
 * reusable domain theories
 * method integration
 * hardware verification

In addition to presentations of submitted papers, the symposium will
offer tutorials, workshops, invited speakers, and tool demonstrations.

PAPERS

Full papers should be submitted in Postscript or PDF format by e-mail to
reach the Program Co-chairs by 15 January 2002. Papers will be refereed by
the Program Committee and must be original research papers that have not
been submitted elsewhere for publication. Accepted papers will be published
in the symposium proceedings.

Papers should not exceed twenty pages, although longer papers will be
considered if their content justifies it. LNCS format should be used: see
 http://www.springer.de/comp/lncs/authors.html for details.
Please include a short list of keywords on a separate line at the end of
the abstract, beginning with the word Keyword: in boldface.

OTHER SYMPOSIUM ACTIVITIES

Tutorials and workshops will be held on 20-21 July 2002. Each tutorial will
last one-half or one day. Proposals are welcome, and should be directed to
the Program Co-chairs by 15 January 2002; more details will appear on the
web-site above.

Tool demonstrations will also take place during the symposium, with the
opportunity for presentations to be made about each tool. Proposals for
tool demonstrations should be made to the Tool Demonstration Coordinator,
with whom provison of necessary computing facilities should be discussed.

PEOPLE

Organising Chair

   Dines Bjørner
 Informatics and Mathematical Modelling
 Building 322, Richard Petersens Plads
 Technical University of Denmark
 DK-2800 Lyngby, Denmark
 Tel: +45 4525 3720
 Email: [EMAIL PROTECTED]

Programme Co-chairs

   Lars-Henrik Eriksson, Industrilogik L4i AB
 Box 6205, SE-102 34 Stockholm, Sweden
 Tel: +46 8 670 37 10   Fax: +46 8 32 12 82
 Email: [EMAIL PROTECTED]

   Peter Lindsay, Software Verification Research Centre
 The University of Queensland, Queensland 4072, Australia
 Tel: +61 7 3365 2005  Fax: +61 7 3365 1533
 Email: [EMAIL PROTECTED]

Programme Committee

   Bernhard Aichernig   Graz University of Technology, Austria
   Juan Bicarregui  Rutherford Appleton Laboratory, UK
   Ernie Cohen  Telcordia Technologies, USA
   Ben Di Vito  NASA Langley Research Center, USA
   Cindy Eisner IBM Haifa Research Laboratory, Israel
   Lars-Henrik Eriksson (co-chair)  Industrilogik, Sweden
   John Fitzgerald  Transitive Technologies Ltd, UK
   Jim Grundy   Intel Corporation, USA
   Yves Ledru   LSR/IMAG, France
   Peter Lindsay (co-chair) University of Queensland, Australia
   Markus Montigel  University of New Orleans, USA
   Richard MooreIFAD, Denmark
   Tobias NipkowTechnische Universität München, Germany
   Colin O'Halloran Qinetiq (ex-DERA), UK
   Jose OliveiraUniversidade do Minho, Portugal
   Nico PlatWest Consulting, The Netherlands
   Jeannette Wing   Carnegie Mellon University, USA
   Jim 

RE: Another question about sharing

2001-12-10 Thread Simon Marlow


 I'm curious, how does GHC determine that the CAF is no longer required
 if it is referenced by code (somehow)? If code was also some kind of
 heap allocated data structure I guess this would be possible, but I
 thought this wasn't so with GHC.

GHC actually tracks references to top-level entities from code, so that
the GC can trace the transitive closure of live code and hence find all
the reachable CAFs.  It's a real pain, but worth it.

 But in any case, I'm not sure this really helps me. I don't really
 mind if the unreduced form of the CAF is garbage collected or not
 (it's only going to be a few words of memory). The effect I'm trying
 to get is to ensure that the (partially) reduced form of the CAF only
 lives as long as any (non code) heap object which references it.
 Does that make sense? (probably not:-)

If I understand correctly, that's the behaviour you'll get with GHC, and
(I think) nhc98.

Cheers,
Simon

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



Re: Another question about sharing

2001-12-10 Thread Malcolm Wallace

  data Path = L Path | R Path | T
  paths = T : branch paths
  branch (p:ps) = L p : R p : branch ps

 This code was originally written in Clean, and the Clean designers
 addressed this problem by allowing the programmer to distinguish
 between constants and functions with no arguments. (The latter
 being a fragment of code which reconstructs the constant each time
 it's called, rather than having just one occurrence as a CAF.)
 It's typically used to inhibit sharing.
 
 I don't believe there is any such distinction in Haskell.
 I thought maybe there was a trick you could use in Haskell to
 achieve the same effect

Well, how about the following little circular program?

paths :: () - [Path]
paths () = let r = T : branch r in r

As far as I can understand what you are looking for, I think this meets
the bill.  Every use of the expression `paths ()' will re-evaluate
the infinite structure to the extent its context requires it, and the
expanded value will be thrown away as soon as the value of this
instance of `paths ()' is no longer required.

Regards,
Malcolm

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



RE: Another question about sharing

2001-12-10 Thread Simon Marlow

 Well, how about the following little circular program?
 
 paths :: () - [Path]
   paths () = let r = T : branch r in r
 
 As far as I can understand what you are looking for, I think 
 this meets
 the bill.  Every use of the expression `paths ()' will re-evaluate
 the infinite structure to the extent its context requires it, and the
 expanded value will be thrown away as soon as the value of this
 instance of `paths ()' is no longer required.

You can't rely on adding dummy arguments to cause re-evaluation:
full-laziness (enabled when optimisation is on in GHC) will do the
opposite transformation.

Cheers,
Simon

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



Re: Another question about sharing

2001-12-10 Thread Malcolm Wallace

 You can't rely on adding dummy arguments to cause re-evaluation:
 full-laziness (enabled when optimisation is on in GHC) will do the
 opposite transformation.

Well in this case, you may find it harder to claim that the full
laziness transformation constitutes an `optimisation'.  Maybe the
GHC manual should have a section on Flags for worsening the space
behaviour of programs.  :-)

Seriously, would it be difficult to detect when performing this
`optimisation' would introduce a CAF and perhaps back it out
appropriately?

Regards,
Malcolm

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



RE: Another question about sharing

2001-12-10 Thread Simon Marlow

  You can't rely on adding dummy arguments to cause re-evaluation:
  full-laziness (enabled when optimisation is on in GHC) will do the
  opposite transformation.
 
 Well in this case, you may find it harder to claim that the full
 laziness transformation constitutes an `optimisation'.  Maybe the
 GHC manual should have a section on Flags for worsening the space
 behaviour of programs.  :-)
 
 Seriously, would it be difficult to detect when performing this
 `optimisation' would introduce a CAF and perhaps back it out
 appropriately?

The problem isn't restricted to CAFs - full laziness always trades space
for time.  We found that it can be a large win in some cases: if
repeated computation is replaced by sharing in an inner loop, then the
gains can be dramatic.  We didn't meet any cases where it caused space
problems, so you get it by default[1] when optimisation is turned on in
GHC.  You can always disable it with -fno-full-laziness.

Cheers,
Simon

[1] Actually what you get is almost-full-laziness: GHC won't split
adjacent lambda abstractions if it finds it can float an expression past
some of the lambdas but not all.

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



Re: Clarification of \begin{code} ... \end{code} stuff

2001-12-10 Thread Ian Lynagh

On Mon, Dec 10, 2001 at 04:03:27PM +, Ian Lynagh wrote:
 
 In the thread Literate scripts not handled correctly Simon Marlow
 said:
 
  Yes, it looks like GHC's unlit program removes whitespace when looking
  for \begin{code}, but not for \end{code}.  The report isn't explicit
  about whether whitespace is allowed on these lines, but I would tend to
  the view that it isn't.
 
 Can you please clarify this in the report [...]

Here's an interesting snippet:

\begin{code}

foo = hello\
\end{code}

\end{code}

which nhc and hugs accept, GHC says error in character literal.
I think this is a good reason for at least non-whitespace to not be
allowed on the \begin{code} and \end{code} lines (or rather, for lines
with other non-whitespace on them not to be treated as such).


Thanks
Ian


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



SPJ (and others') book. Was: Pointers in Haskell??

2001-12-10 Thread Jerzy Karczmarczuk

Mark P Jones comments:

...
 
 |   Simon Peyton-Jones. The implementation of functional
 |   programming languages. Prentice-Hall, 1987
...
 | This book is already on-line at
 |
 | http://research.microsoft.com/Users/simonpj/Papers/student.ps.gz


 That's a useful resource too, but it's not the book that the first
 poster mentioned.  The earlier book was more advanced, more
 research-oriented, and (in most respects) covered more material
 than the later one (which was intended as an executable tutorial).
 
 Personally, I honestly don't think I would have been able to put
 Gofer together without many hours poring over Simon's 1987 book.

Just for the record: this wonderful (really!) book has others authors
as well: Philip Wadler, Peter Hancock,... contributed, writing some 
chapters.

Jerzy Karczmarczuk
Caen, France

PS. The Haskell mailing group received - as you know - an ad:
 
  LIL DRIVER GOLF CART
   The Perfect Holiday Gift for the 3 to 7 year old golfer!

Would somebody care writing to those people asking them to correct the name
golfer which has a redundant l?

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



RE: instance declarations

2001-12-10 Thread Mark P Jones

Hi Marcin,

|  There's no solid technical reason for this, but Haskell doesn't allow
|  it at the moment because there isn't an easy way to name an instance
|  declaration.
| 
| There is another problem: even if we created a syntax to name them,
| if they would not be exported by default then current programs would
| have to be changed.

You're right of course, although I consider this a pragmatic issue
rather than a technical problem:  I'm thinking of future languages
that are inspired by current Haskell standards but not constrained
by details of the current definition or existing codebase.

All the best,
Mark


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



RE: Pointers in Haskell??

2001-12-10 Thread Simon Peyton-Jones

|  Simon Peyton-Jones. The implementation of functional
|  programming languages. Prentice-Hall, 1987
| 
| is this book could be made available online ? cos on amazon 
| it seems out of print.

I'm planning to scan it in and make the copy available online.
In the next month or two.

Simon

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



Re: instance declarations

2001-12-10 Thread Ketil Z Malde

David Feuer [EMAIL PROTECTED] writes:

 1.  Why can't [instances] be hidden in module imports/exports?

The way I see it, an instance declaration is an assertion that a
certain data type supports a certain set of operations.  Thus, if the
data type and the operations on it are in scope, it makes sense for
the class instance to be, too.

(This leads to the question of why we need to have instance
declarations at all :-)  (My guesses would be: compiler
implementation issues, code clarity, error detection, partially
implemented classes))

Problems arise when a data type needs to be instantiated twice in the
same class, but with different operator implementations.  (I.e. you
have a data type which prints differently according to which module
you're in)

This would, I think, be a problem in most languages, think of deriving
a C++ class twice from the same base class while providing different
overrides for the functions.

I'm not entirely convinced it's an issue that needs a better
resolution than the language provides today.  (There's a diminishing
returns effect when adding language features, and at some point, the
increased complexity of the language doesn't make it worth it, IMHO.)

 2.  Why can't you simultaneously declare a type to be an instance of
 multiple classes?

Why does it matter?

 class C1 t where a::t-t
 class C1 t = C2 t where b::t-t
 instance C1 T, C2 T where
   a=...
   b=...

To me, it'd make more sense to provide

class C1 t where a :: t - t
class (C1 t) = C2 t where b :: t - t

instance C2 T where
a = ...  -- implicitly instantiating C1
b = ...

and avoid long instantiation chains.  But that too is IMHO a minor issue.

-kzm
-- 
If I haven't seen further, it is by standing in the footprints of giants

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



Re: Pointers in Haskell??

2001-12-10 Thread William Lee Irwin III

On Mon, Dec 10, 2001 at 12:58:33AM -0800, Simon Peyton-Jones wrote:
 |  Simon Peyton-Jones. The implementation of functional
 |  programming languages. Prentice-Hall, 1987
 | 
 | is this book could be made available online ? cos on amazon 
 | it seems out of print.
 
 I'm planning to scan it in and make the copy available online.
 In the next month or two.

At long last! Thank you so very much!


Thanks,
Bill

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



Re: cond and match

2001-12-10 Thread Hannah Schroeter

Hello!

On Sun, Dec 09, 2001 at 01:07:08PM +, Marcin 'Qrczak' Kowalczyk wrote:
 Fri, 7 Dec 2001 17:12:52 -0500 (EST), David Feuer [EMAIL PROTECTED] pisze:

  I'm wondering why Haskell doesn't support Scheme-like cond statements
  or a pattern matching predicate.

 I agree that both constructs make sense. The main objective is probably
 that the syntax is already quite rich and this would be another thing
 to learn and implement.

As well, these constructs would reserve two more identifiers and so
break quite some existing programs. I could expect that especially
match could be used sometimes, like
let match = search foo bar in
use match somehow

Kind regards,

Hannah.

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



Re: (no subject)

2001-12-10 Thread David Feuer

uma kompella wrote:
 
 hi
 
 i am new to haskell and am having a problem to write
 function which takes a boolean expression and returns
 a truthvalue stating whether or not it is a tautology.
 
 Can anyone please help me??
 
 Thanks a lot
 uma

I assume this is your homework.  It is better to say so explicitly.

Think about this:  what does it mean for an expression to be a
tautology?  Can you think of an a way to check this?  Once you've come
up with a way to check this, it should be quite easy to write it in
Haskell.
-- 
/Times-Bold 40 selectfont/n{moveto}def/m{gsave true charpath clip 72
400 n 300 -4 1{dup 160 300 3 -1 roll 0 360 arc 300 div 1 1 sethsbcolor
fill}for grestore 0 -60 rmoveto}def 72 500 n(This message has been)m
(brought to you by the)m(letter alpha and the number pi.)m(David Feuer)
m([EMAIL PROTECTED])m showpage

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



Re: (no subject)

2001-12-10 Thread Ashley Yakeley

At 2001-12-10 16:07, uma kompella wrote:

i am new to haskell and am having a problem to write
function which takes a boolean expression and returns
a truthvalue stating whether or not it is a tautology.

If you really want to impress your tutor, see if you can find a function 
that does this in polynomial time.

-- 
Ashley Yakeley, Seattle WA


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