Re: Large FiniteMap causes SIGSEGV in ghc-4.04

1999-08-23 Thread Michael Weber

On Sat, Aug 21, 1999 at 11:59:25 +, Marcin 'Qrczak' Kowalczyk wrote:
 import FiniteMap
 main = print . fmToList . listToFM $ [(i,0) | i - [1..3]]
 
 This program simply segfaults. With less than 2 elements it works.
 With ghc-4.02 it works.

*hmm* this works with ghc-4.04 of 1999/08/03 on Linux, but I had to increase
stack size, i.e.
./fmtest +RTS -K2M

Also, I have a project that generates big finite maps (5+ elements, ~30M
mem) and had never problems with that (on Solaris and Linux)...


Cheers,
Michael
-- 
Those who open their minds too far often let their brains fall out.
Those who open their minds too far often let their brains fall out.
Those who open their minds too far often let their braGeneral Protection Fault
in msborg32.dll.



Re: Large FiniteMap causes SIGSEGV in ghc-4.04

1999-08-23 Thread Marcin 'Qrczak' Kowalczyk

Sun, 22 Aug 1999 03:39:11 +0200, Michael Weber [EMAIL PROTECTED] 
pisze:

 *hmm* this works with ghc-4.04 of 1999/08/03 on Linux, but I had to increase
 stack size, i.e.
   ./fmtest +RTS -K2M

Ah, thanks. Surprisingly, with 1 elements and 4.04 it needs at
least -K4M, but with 4.02 it crashes no matter how much is given
(I guess it reaches some hard maximum).

 Also, I have a project that generates big finite maps (5+
 elements, ~30M mem) and had never problems with that (on Solaris
 and Linux)...

Maybe it matters that your project does not build the map from one
huge list? I looked at addListToFM_C and I guess that foldl is what
needs this stack, and only because it is lazy, am I right? Could it
be written so it does not need so much stack (with no bad consequences
arising from losing laziness)?

What is better: to build a set from one list or to build independent
sets and join them using Set.union? The sets are joined from small
parts (most are empty, sometimes singletons), the parts are combined
into larger parts and so on, but not many levels. I used the common
trick to join [Element]-[Element] by (.) and `mkSet (combined [])'
at the end, to avoid ++'s walking along the same list multiple
times. Maybe it would be better to union sets from the beginning,
but I thought that unions of mostly emptySets could be slower than
(.)'s of mostly identity functions.

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



Re: FW: Compiling GHC

1999-08-23 Thread Manuel M. T. Chakravarty

"Jeffrey R. Lewis" [EMAIL PROTECTED] wrote,

 Mark Utting wrote:
 
  Simon wrote:
   Can anyone help with this?  Simon and Sigbjorn are both
   on holiday, and I am wonderfully ignorant about such things.
 
   John McCarten wrote:
   I recently emailed you concerning the installation of GHC,
   I have now managed to install and configure to some degree the
   system, however it 'compiles' a haskell script but fails when
   trying to import the library gmp, giving the message:...
 
  [I don't know if this will be much help, but...]
  I've had a lot of trouble trying to install GHC 4.04 under
  Linux too, both from the binary distribution and the source one.
  This gmp problem was fairly easy to fix, I just hunted
  around the (source) directory tree and found that gmp is actually
  included in the GHC distribution and that libgmp.a had been built,
  but was just not in the right path for the linker to find it.
  Copying that .a file into the directory where ghc was being linked
  fixed the problem.  So this looks like a problem with the Makefiles.
 
 
 If you are using a redhat distribution, the solution is even easier:  install
 the rpm `gmp' (you might also need `gmp-devel').  Both of these are in the
 standard 6.0 distribution.

Or, if you like it super-easy (this is for RedHat 6.0 and
similar systems)

  rpm -i ftp:[EMAIL PROTECTED]/pub/jibunmaki/i386/ghc-4.04-1.i386.rpm

Preferably *after* you have deleted all traces of your
earlier attempts to install GHC.

Manuel



RE: FW: Compiling GHC

1999-08-23 Thread Simon Marlow

 [I don't know if this will be much help, but...]
 I've had a lot of trouble trying to install GHC 4.04 under
 Linux too, both from the binary distribution and the source one.  
 This gmp problem was fairly easy to fix, I just hunted
 around the (source) directory tree and found that gmp is actually
 included in the GHC distribution and that libgmp.a had been built,
 but was just not in the right path for the linker to find it.
 Copying that .a file into the directory where ghc was being linked
 fixed the problem.  So this looks like a problem with the Makefiles.

I didn't include libgmp.a with the Linux distributions, on the grounds that
(a) most Linux installations either come with a libgmp, or one that can be
installed separately and (b) the system-supplied libgmp is a shared library,
which is obviously better than providing a static one with ghc.

So the upshot is that if your system doesn't have the gmp library installed,
you need to either install it, or build one from the GHC sources.

 But next I found that when you try to link the standard hello world
 Main.hs, the linker complains about a missing
 'data_start' that is called from the GHC libraries.  The only
 "data_start" we can find is an unsigned long in an Alpha/OSF a.out 
 header file, but it is not obvious how/why it is in the ghc library
 for an i386 linux distribution.
 We conjecture that the distribution was either cross-compiled 
 on an Alpha,
 or something else happened which mixed some Alpha stuff into the
 Linux binary distribution?

The data_start symbol is supposed to be automatically inserted by the linker
to point to the start of the data section.  At least, that's the way it
works on our Linux boxes here.

You may have out of date compilers/linkers/libraries, I'm not sure which.

 Actually, I'm a bit unclear about what is needed to build GHC
 from source.  The source distribution does not seem to contain
 many .hc files, so I assume you have to have a running version
 of GHC in order to compile GHC!  Will GHC 3 do?  That binary version
 does install easily.

GHC 3.02 is enough to compile 4.04, but a bootstrapped version will be
faster.

Cheers,
Simon



RE: Compiling GHC

1999-08-23 Thread Simon Marlow

John McCarten writes:

 I recently emailed you concerning the installation of GHC, 
 I have now managed to install and configure to some degree the
 system, however it 'compiles' a haskell script but fails when
 trying to import the library gmp, giving the message:
 
 ld: Software Generation Utilities - Solaris/ELF (3.0)
 ld: fatal: library -lgmp: not found
 ld: fatal: File processing errors. No output written to hello
 collect2: ld returned 1 exit status

The sparc-sun-solaris2 distribution of GHC 4.04 comes with the gmp library,
so you shouldn't have a problem there.  Which version of GHC is this, and
where did you get the binaries from?

 Aside from this when I try to use make with the Ebnf2ps ebnf 
 syntax diagram generator source I recieve the following error:
 
 rm -f Parsers.o
 ghc -c -O -fvia-C -O2-for-C -cpp -syslib posix -fglasgow-exts 
 -fhaskell-1.3 -H27M -DAFMPATH=\\\"/usr/local/tex/Adobe\\\" 
 -DRGBPATH=\\\"/usr/lib/X11\\\" Parsers.hs -o Parsers.o
 ghc: unrecognised option: -fhaskell-1.3
 
 Usage: For basic information, try the `-help' option.
 *** Error code 1
 make: Fatal error: Command failed for target `Parsers.o'
 
 I could not find documentation on the option -fhaskell-1.3.

-fhaskell-1.3 is an old option (removed in GHC 2.00, I think).  Just remove
this option from your Makefile and you should be ok.

Simon



RE: ghc-4.04 -O: panic! mk_cpr_let: not a product

1999-08-23 Thread Simon Peyton-Jones

 
 lips ghc-4.04 -O -c -fglasgow-exts MonadLibrary.lhs
 
   panic! (the `impossible' happened):
   mk_cpr_let: not a product
   forall a{-ruq-} b{-rur-}.
   (a{-ruq-} - b{-rur-})
   - MonadLibrary.StateM{-r2o,x-} m{-a30Y-} s{-a30Z-} a{-ruq-}
   - MonadLibrary.StateM{-r2o,x-} m{-a30Y-} s{-a30Z-} b{-rur-}


This is a genuine bug in the (new) CPR analysis.  I've boiled it down
a bit and sent it off to Kevin Glynn whose analyser it is.

To avoid it, you need to switch CPR analysis off.  Alas, we didn't give
you a way to do so!   So, you can check out
the current GHC from the repository and use "-fno-cpr" (which I've just
added), or you can
remove the line "-fcpr-analyse" from ghc/driver/ghc.lprl and re-make.
In your binary distribution you can do the same thing to ghc*.

Either way, -fno-cpr will be in patch-level 1 version of 4.04, and
I hope Kevin will have a fix for his analyser by then as well.

Thanks for reporting this one.

Simon



Frank A. Christoph: FastString in GHC

1999-08-23 Thread simonmar


I have been looking at the GHC 4.04 sources a little lately and in the
module FastString (in ghc/compiler/utils), the instance for Eq is defined as
follows:

  instance Eq FastString where
a == b = case cmpFS a b of { LT - False; EQ - true; GT - False }
...

and cmpFS will return EQ if the unique IDs of a and b match, otherwise it
just does a ccall to strcmp.

What I don't understand is why you don't just define (==) so that to
FastStrings are equal if and _only_ if their unique IDs are equal. Isn't the
whole point of FastString that identical strings and only identical strings
will get the same ID? The ID's not the string's hash value, as far as I can
see, and with the present definition you will check each character in the
string when the result of (==) is False.

Am I missing something?

- --FC



Re: NON-daemonic forking

1999-08-23 Thread George Russell

Michael Weber [EMAIL PROTECTED] wrote
[snip]
 forkChild :: IO () - IO (MVar ())
 forkChild p = do
 mvar - newEmptyMVar
 forkIO (p  putMVar mvar ())
 return mvar
This does not of course synthesise a non-daemonic forkIO from a daemonic one, because
it requires the parent thread to wait for the MVar.  I suppose that a possible 
alternative
to having separate daemonic and non-daemonic forking would be to have an atexit-type
function:
   atThreadExit :: IO () - IO()
which forkChild could use to wait for the mvar.  But I'm not sure I like this, unless
there are other likely uses for atThreadExit.



Re: Licenses and Libraries

1999-08-23 Thread Manuel M. T. Chakravarty

"Erik Meijer" [EMAIL PROTECTED] wrote,

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

That's interesting, indeed.  I am also close to finishing
the first version of a tool that simplifies Haskell access
to C libraries by extracting interface information from C
headers.  Actually, I have just completed the draft of a
paper about the tool that I plan to present at IFL'99 next
month: 

  ``C - Haskell, or Yet Another Interfacing Tool''
  http://www.score.is.tsukuba.ac.jp/~chak/papers/Cha99b.html

 Hopefully this will convince the COM criticasters and MS
 sceptists that H/Direct is cool indeed.

I for one never doubted that H/Direct is cool.  This is not
a matter of being critical towards COM; it is a matter of
"COM doesn't run on my Linux box" (nor does it run on SunOS,
HP/UX, etc).

Anyway, I am still thinking about adapting H/Direct to work
with GNOME (www.gnome.org - the GNU answer to COM, DCOM, and
ActiveX) when I am through with GTK+.

Manuel





Re: Question

1999-08-23 Thread Marko Schuetz

 "Will" == Will Partain [EMAIL PROTECTED] writes:

Will Marko Schuetz [EMAIL PROTECTED] writes:
 ... It has taken the Haskell community quite some time to
 switch to liberal licenses. IIRC only Hugs used to come
 with a license at all, neither hbc, ghc nor nhc used to
 have one for quite some time.

Will GHC has always had a "liberal license", it just wasn't
Will written down :-) There has never been a whisper of any other
Will terms than "it's freely available, and we'd be delighted if
Will you used it".

Yes I know, maybe should have written 'explicitly publish their
compilers with` instead of 'switch to'. 

In some countries "If it isn't explicitly allowed it's forbidden"

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





Wiki Sites

1999-08-23 Thread Rob MacAulay

There seems to be some interest in setting up a collaborative site, 
but no-one seems to know how to go about doing it.

One possible solution would be a Wiki (formerly WikiWiki) site. 
This was also mentioned some time ago, but, again, no-one 
seemed to know how to go about doing it.

The good news is that my good friend Andy Bower has re-
implemented a Wiki server to run part of the site supporting his 
Dolphin Smalltalk implementation (which is excellent by the way). 
His server is available as a perl script from:

http://www.object-arts.com/wiki/html/Dolphin/DolphinWikiWeb.htm

There are also some links on his site which point to background 
material on Wiki sites in general:

http://www.object-arts.com/wiki/html/Dolphin/WikiWeb.htm

Hope this is of use.

Rob MacAulay

Rob MacAulay  Vulcan Asic___
email : [EMAIL PROTECTED]   \|/
http  : www.vulcanasic.com\   |###/
Tel   +[44] 1763 247624  (direct)  \  |##/
Tel   +[44] 1763 248163  (office)   \ |#/
Fax   +[44] 1763 241291  \|/





Re: Question

1999-08-23 Thread Antti-Juhani Kaijanaho

On Mon, Aug 23, 1999 at 11:12:15AM +0200, Marko Schuetz wrote:
 In some countries "If it isn't explicitly allowed it's forbidden"

In most countries, you mean.  This includes every country whose copyright
laws are based on the Berne convention.  I know the USA and Finland
are like this, and I believe it's also the case in all of the EU, too -
and in many other countries.

-- 
%%% Antti-Juhani Kaijanaho % [EMAIL PROTECTED] % http://www.iki.fi/gaia/ %%%

   "... memory leaks are quite acceptable in many applications ..."
(Bjarne Stroustrup, The Design and Evolution of C++, page 220)





Re: Licenses and Libraries

1999-08-23 Thread Manuel M. T. Chakravarty

Jan Skibinski [EMAIL PROTECTED] wrote,

 On Mon, 23 Aug 1999, Manuel M. T. Chakravarty wrote:
 
  That's interesting, indeed.  I am also close to finishing
  the first version of a tool that simplifies Haskell access
  to C libraries by extracting interface information from C
  headers.  Actually, I have just completed the draft of a
  paper about the tool that I plan to present at IFL'99 next
  month: 
  
``C - Haskell, or Yet Another Interfacing Tool''
http://www.score.is.tsukuba.ac.jp/~chak/papers/Cha99b.html
 
   It would be nice having it supported by Hugs as well.

I'll happily support every Haskell system that provides a
functionality similar to

  http://www.dcs.gla.ac.uk/fp/software/hdirect/ffi.html

As I wrote in the paper: It is about time that Haskell gets
a standardised foreign function interface.  And GHC's new
FFI is a very nice design (it is actually quite close to
Hugs `primitive' feature).  

Manuel





propaganda 1: Fast, Error Correcting Parsing Combinators

1999-08-23 Thread S. Doaitse Swierstra

x-richcolorparam,,/parambiggerFast, Error Correcting
Parsing Combinators


/bigger/color(Updated: Aug-19-1999)


I have placed a completely new set of parser combinators on the net at
http://www.cs.uu.nl/groups/ST/Software/Parse/.


I consider my old LL(1) combinators obsolete by now.



colorparam,,/paramWhy would you like to use these
Combinators?


/colorHave you always been intrigued by Combinator Parsers because
they allow you to:


   use the abstraction, typing and naming mechanism of Haskell

   create parsers dynamically

   keep life simple by not having to run a separate program in
order to generate a parser

   work with (limited forms of) infinite grammars


but did you not like:


   expensive backtracking implementations

   bad error reporting and error recovery properties

   my previous combinators because they required the grammar to be
LL(1)

   spurious shift-reduce conflicts reported by other parser
generating tools


then why not use my new parsing combinators? (Provided you have access
to the universal type extensions, as present in e.g. Hugs)


My parser combinators perform (without the programmer having to worry)
left-factorisation of the underlying grammar. The only restriction on
the grammar is that it should not be (neither

directly nor indirectly) left-recursive! If it is, you will soon find
out by running out of stack space. A paper describing the combinators
is in the works. Although the title above uses the word

"deterministic", this may be a bit misleading, since it is well known
fact that not all context free languages can be parsed
deterministically.


I hope this software is useful to you. If you have any comments do not
hesitate to contact me.


Doaitse Swierstra mailto:[EMAIL PROTECTED]

smaller___
___

S. Doaitse Swierstra, Department of Computer Science, Utrecht
University

(Prof. Dr)P.O.Box 80.089, 3508 TB UTRECHT,   the
Netherlands

  Mail:  mailto:[EMAIL PROTECTED]

  WWW:   http://www.cs.uu.nl/

  PGP Public Key:
http://www.cs.uu.nl/people/doaitse/

  tel:   +31 (30) 253 3962, fax: +31 (30) 2513791

__

/smaller


/x-rich







Re: Licenses and Libraries

1999-08-23 Thread Mr. Laszlo Nemeth

Paul Hudak wrote:

 P.S. I really like the idea someone suggested of maintaining a list of
 open projects, who's working on what, etc. as in the Linux community. 

One major difference between the Linux community and the Haskell
community is that in LinuxLand the reward is the name, recognition,
while the people in Haskell community tend to be in academia. They
want POPL papers! Putting your still half baked but most cherished
'BEST IDEA FOR YEARS' on a list may inspire someone else to write the
POPL paper you wanted to write, which means no brownie point for
you...


 But, we need a worker bee to do that too :-)

Not necessarily. If there was an 'Ultimate Collection of Haskell
Related Material' repository (haskell.org(?)) where anyone could check
code/docs/drafts in, one could imagine an automatic browsing tool
instead of the worker bee. Though, this imaginary tool still have to
be implemented in the first place...

Laszlo





Re: Licenses and Libraries

1999-08-23 Thread Manuel M. T. Chakravarty

"Erik Meijer" [EMAIL PROTECTED] wrote,

 In H/Direct you define the interface of some software
 component in IDL (we have supported both MS-IDL and
 OMG-IDL from the beginning). 

The H/Direct paper says (Section 2.2),

  We focus on the IDL used to describe COM interfaces [10],
  which is closely based on DCE IDL [7].  Another popular
  IDL dialect is the one defined by OMG as part of the CORBA 
  specification [11], and we intend to provide support for
  this using the translation from OMG to DCE IDL defined by
  [13, 12].

So, did you support OMG IDL from the beginning or did you
only *intend* to support it from the beginning?

 The crucial point is that the
 component need not be written in C, it can be written in
 Cobol, Fortan, SML, ... (talking about being
 generic). Interfacing to just C is not enough. 

True, but my point is interfacing to C does the job in a
sufficiently significant number of cases to justify
dedicated support - as you admitted when you advertised that 
H/Direct will support reading .h files in the future.

 I gues that Manual is temporarily blinded by his free
 software fanatism (judging from his homepage
 http://www.score.is.tsukuba.ac.jp/~chak/index.html), and

Like you, I am an outspoken proponent of the software
development model that I believe is technically superior -
however, my enthusiasm does not make me call other people
"fanatic" on public mailing lists...

 as a result his paper contains quite some untrue
 statements with respect to the MS-centricity of H/Direct: 

I can not remember having mentioned MS at all (apart when
quoting from your email).

 * page 1: "... to COM support [6,5]." (citing the H/Direct papers)
 OK, one more time H/DIRECT IS NOT TIED TO MS OR COM.

I did not claim this (and there is no reason to shout).  Let
us look at the text that you are quoting in context:

  Hence, it is not surprising that a number of methods have
  been proposed for integrating foreign code into functional
  programs, and in particular, for using imperative code
  with Haskell [12]---approaches range from inline calls to
  C routines [11] to COM support [6, 5].

Obviousy, references [6] and [5] are to support the claim
that there is COM support for Haskell.  Furthermore, [5] is
the "Calling Hell from Heaven and Heaven from Hell" paper,
which discusses nothing but H/Direct's COM support (plus
GHC's new FFI).

 * page 1: "Despite all this previous work, there is an
   interesting approach which has not been explored so
   far,.., access to existing libraries implemented in
   the language C. 
 
 You could say that all FFI prior to H/Direct were about
 interfacing to C culminating in GreenCard. 

Let's again look at the text that you omitted from your
quotation:

  Despite of all this previous work, there is an interesting
  approach, which has not been explored so far and which,
  moreover, is especially attractive for the most frequent
  application of a \emph{foreign language interface (FLI)}:
  access to existing libraries implemented in the language
  C.

I admit that the wording is ambiguous, but the intended
meaning is that "access to existing libraries implemented in
the language C" is the most frequent application of a FLI -
which is true.

 * throughout the paper: you say that in your approach the
   programmer does not have to learn a dedicated interface
   language.  
 
 Well, in some sense .h files are a dedicated interface
 language (and IDl is nothing more than a header file with
 some directional attributes). 

The difference is that a programmer writing a Haskell
binding to a C library already knows C and Haskell, but not
necessarily IDL.  Moreover, in my approach the already
existing prestine C header file is used, which *always* is
available for a C library.  The IDL file you usually have to
write yourself and constantly keep up to date with new
releases of the C library.

 Moreover, your binding hooks are nothing but a dedicated
 interface description language!

True, but a very simple one when compared to others.

 * page 9: "The design of a matching structure in Haskell
   requires algorithmic insight that hardly can be
   automated; neither can the structure be encoded in
   IDL. So, after all, the required marshalling has to be
   handcoded in Haskell." 
 
 We have never claimed that this is the case. In fact, we
 have always said that the generated Haskell stubs are just
 the starting point of a long abstraction process to give a
 nice interface to a software component (see the papers
 "Haskell as an automation controller" and "Client-side
 scripting using HaskellScript"). 

And I have never claimed that you have claimed so -
actually, I would have been very surprised if you had.

 * last page: "... GHC's new FFI ..." 
 
 This FFI is not specific to GHC, we proposed it as the
 standard basic FFI for Haskell. 

I know, I used this phrase only due to lack of a different
name for the FFI - any suggestions?

 A more general question, which is not 

Monads in plain engllish (Was: Re: Licenses and Libraries)

1999-08-23 Thread felix


-Original Message-
From: Keith Wansbrough [EMAIL PROTECTED]
To: Ted Carroll [EMAIL PROTECTED]
Cc: Mark P Jones [EMAIL PROTECTED]; [EMAIL PROTECTED]
[EMAIL PROTECTED]; [EMAIL PROTECTED] [EMAIL PROTECTED]
Date: 23 August 1999 14:38
Subject: Re: Licenses and Libraries


[..]
 Ted C.

 P.S.  If somebody could explain Monads in plain english it might not
 hurt either.

Someone already has:

http://www.dcs.gla.ac.uk/~nww/Monad.html

--KW 8-)

Yes, that text is not bad, but I think it still has a problem (one I found
in two or
three other introductory texts of monads): it stops right before getting
really interesting!
The examples are probably well thought out, but they are either just toy
stuff or they
are to special. There are so many questions still open: how to declare an
instance of
the 'Monad' class (for using 'do'-constructs) combined with a plain
state-monad, for example.
The standard-prelude doesn't really contain any good examples. 'IO' is too
abstract
to be of any use. Yes, I can figure all that out (and I do, with some work)
but most certainly
someone else already did that.

Don't get me wrong here: I think Haskell is the culmination of decades of
Programming-
Language reasearch, but, coming from the LISP direction, I really have
trouble to adapt to
the totally different terminology found in functional programming.
Everything just looks
so darn complicated - even if you are basically just doing the same thing:
CONS, APPLY,
and LAMBDA.

felix

P.S.: Can someone point me to a good book on functional programming ? One
which
doesn't bore you with trivialities, but comes right to the point and
explains everything
with real-world examples ? Just the one book specially written for a stupid
LISPer
with bad grades in mathematics, like me ? :-)







Re: A Haskell-Shell

1999-08-23 Thread Keith Wansbrough

 And there is _no_ handle to the output of the command! An obvious hack is
 to use redirecting; here is how you implement a simple date function in
 Haskell:
 
   date :: IO String
   date =
 do system "date  /tmp/answer"
readFile "/tmp/answer"
 
[..]
 I implemented these functions and a couple more (dealing with lazily
 generating output) in Hugs, using dynamic named pipe generation and
 redirecting. This is a hack; it would be much nicer to have a function
 like "sysInOut" builtin in Hugs (Haskell98).

There is no need (that I can see) to use named pipes... here is some
code I used (in GHC; haven't tried it in Hugs).  Disclaimer: it's
*not* production code, and is ugly [I suspect it doesn't really need
two forks], but works for me.  It actually does a few other things as
well, but you should be able to pick out what you need.

import IO
import Posix
import System
-- and maybe a few other things too

teeProcess :: (String - String)
   - FilePath - Bool - [String] - Maybe [(String,String)] - IO 
(ExitCode,String)
-- as executeFile, but merges stdout and stderr, outputting them together on stdout
-- (via a filter function) and also returning them as a string.
teeProcess f prog pathp args menv
  = do { (pin,pout) - createPipe
   ; mpid - forkProcess
   ; pid - case mpid of
  Nothing  - do { mprocPid - forkProcess
 ; procPid - case mprocPid of
Nothing  - do { dupTo pout (intToFd 1)
   ; dupTo pout (intToFd 2)
   ; executeFile prog 
pathp args menv
   ; error "teeProcess:1"
   }
Just pid - return pid
 ; status - getProcessStatus True False procPid
 ; ec - case status of
   Just (Exited ec)  - do { fdClose pout
   ; return ec
   }
   Just (Terminated sig) - do { raiseSignal 
sig
   ; error 
"teeProcess:2"
   }
   Just (Stopped sig)- error "teeProcess: 
process stopped"
   Nothing   - error "teeProcess: 
no info"
 ; exitWith ec
 ; error "teeProcess:3"
 }
  Just pid - return pid
   ; fdClose pout
   ; hpin  - fdToHandle pin
   ; hSetBuffering hpin LineBuffering
   ; str - hGetContents hpin   -- lazily
   ; putStr (f str)
   ; status - getProcessStatus True False pid
   ; ec - case status of
 Just (Exited ec)  - return ec
 Just (Terminated sig) - do { raiseSignal sig ; error "teeProcess:4" }
   ; return (ec,str)
   }


Hope this is of use.

--KW 8-)





Re: Licenses and Libraries

1999-08-23 Thread Keith Wansbrough

[..]
 Ted C.
 
 P.S.  If somebody could explain Monads in plain english it might not
 hurt either.

Someone already has:

http://www.dcs.gla.ac.uk/~nww/Monad.html

--KW 8-)





RE: Wiki Sites

1999-08-23 Thread Simon Peyton-Jones

 One possible solution would be a Wiki (formerly WikiWiki) site. 
 This was also mentioned some time ago, but, again, no-one 
 seemed to know how to go about doing it.

It would be great to have a Haskell Wiki.  As I understand it,
to host a Haskell Wiki would require:

a) providing a suitable Web server
b) getting a Wiki implemenentation
c) setting up the initial instructions and structure
(front page, categories, FAQ, search pages..)
d) performing some regular house-keeping to try to keep
the structure comprehensible

I believe that this is all fairly simple except perhaps (c),
which I find hard to quantify.


Would anyone like to volunteer to provide such a thing?  
John Peterson was going to look into it, but he's pretty
busy, and I very much doubt he'd be in despair if someone else
volunteered.  You don't have to be a Haskell expert; indeed, it
might be an advantage not to be.

Mark Jones sent round a recent message about widening contributions
to Haskell -- this might be a good way of doing so.

Simon





Re: Licenses and Libraries

1999-08-23 Thread Daan Leijen


 "Daan Leijen" [EMAIL PROTECTED] wrote,

  Sigbjorn Finne has done a lot of work to make sure that H/Direct can
handle
  any standard and dialect of IDL that is around, including
  OMG/Corba IDL's.  H/Direct can generate interface code to
  any C library that is described with IDL (which is
  normally just adding some attributes to the C header file)
 [...]
  Secondly, it is quite easy to extend H/Direct to support
  other protocols (like GNOME).

 "Manuel M. T. Chakravarty" [EMAIL PROTECTED] wrote,

 I know that and how H/Direct supports...I don't dare to say
 it...COM and plain C.  However, what I am unclear about is
 how does it support OMG's CORBA IDL?  As you mention in the
 H/Direct paper, COM fixes a language-independent, binary
 interface, but CORBA IDL doesn't do that.  Did you define a
 CORBA language mapping for Haskell?

Hi Manuel,

Unfortunately, there is more than one IDL around, they all look
the same and can basically express the same things.
Fortunately, H/Direct can get its input from both OMG /CORBA and
MS dialect IDL and extract the right semantic information.
In a sense, it doesn't matter in what language you describe your
interface as long as it gives enough information to generate marshalling
code. (that's why it is possible to even use C header files, allthough you
need some heuristics and/or extra directives, as you show in your paper).

We have not defined a CORBA *mapping* however. C and COM are
specific protocols for which we defined a mapping and generate marshall
code.
To *specify* an interface in C or COM, you can use any sort of IDL,
including OMG/CORBA IDL.
(btw. since the 'C' binding is actually a (dynamic or static) library
binding, it
supports also languages like pascal, fortran and many others with standard
calling conventions (cdecl, pascal, stdcall, fastcall,...))

The bad thing is that Corba is not a binary protocol and thus H/Direct needs
a different backend/mapping for each different Corba vendor. Many languages
provide
a Corba binding by providing their own Corba environment and interacting
with other Corba environments via the IIOP (internet) protocol of Corba
which
*is* a binary standard.
(Things are not really that bad since it seems that vendors start to
standarize on
object layout).

 If not, how can you
 support CORBA?  To support GNOME, the next step is to
 support the binary interface defined by ORBit (GNOME's
 Object Request Broker).  I guess that this means tweaking
 the marshaling code generation.  This you think is easy?

Supporting Corba would be a lot harder as said above. One approach could be
to just support one environment, I can't recall the name but there is one
excellent
free implementation around of corba (minicorba  or something ?)

Supporting Orbit however seems quite easy and it would be very cool to have
around, allowing for a comparison between COM and ORBit.
You should contact Sigbjorn Finne on the exact details but if
ORBit looks like COM (which is probably true) than it wouldn't
too much work.

 (I'd be really interested to get some more information about
 this, because, as I mentioned, I am interested in adding
 such support.)

It would be very nice to have someone adding these features to
H/Direct, especially since you are working with big frameworks
like GTK. This would have been a nice test of H/Directs abilities
and in a sense it is disappointing to learn that H/Direct didn't fit
your needs completely. I hope to learn how H/Direct can be improved
to take away the need for yet another FFI, which was our primary motivation
for building H/Direct.

All the best,
Daan.

 All the best,
 Manuel







Re: Licenses and Libraries

1999-08-23 Thread Marcin 'Qrczak' Kowalczyk

Sun, 22 Aug 1999 00:30:29 +0200, Erik Meijer [EMAIL PROTECTED] pisze:

 Well, in some sense .h files are a dedicated interface language
 (and IDl is nothing more than a header file with some directional
 attributes).

I already know C and .h format. Where can I learn IDL?

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






Re: Wiki Sites

1999-08-23 Thread Marko Schuetz

 "Simon" == Simon Peyton-Jones [EMAIL PROTECTED] writes:

 One possible solution would be a Wiki (formerly WikiWiki) site. 
 This was also mentioned some time ago, but, again, no-one 
 seemed to know how to go about doing it.

Simon It would be great to have a Haskell Wiki.  As I understand it,
Simon to host a Haskell Wiki would require:

Simon a) providing a suitable Web server

AFAIK the widest selection of WikiClones can be had by running
Apache. 

Simon b) getting a Wiki implemenentation

There is a list of WikiClones at
http://c2.com/cgi/wikibase?LongListOfWikiClones (incidentally, this is
a wiki page itself ;-))

Someone might even want to volunteer to implement the WikiClone used
for the Haskell Wiki in Haskell.

Simon c) setting up the initial instructions and structure
Simon  (front page, categories, FAQ, search pages..)
Simon d) performing some regular house-keeping to try to keep
Simon  the structure comprehensible

Simon I believe that this is all fairly simple except perhaps (c),
Simon which I find hard to quantify.

d) and most of c) should mostly be done by the user/author community.

Marko

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





Re: Monads in plain engllish (Was: Re: Licenses and Libraries)

1999-08-23 Thread Theo Norvell

On Mon, 23 Aug 1999, felix wrote:

  P.S.  If somebody could explain Monads in plain english it might not
  hurt either.
 
 Someone already has:
 
 http://www.dcs.gla.ac.uk/~nww/Monad.html
 
 --KW 8-)
 
 Yes, that text is not bad, but I think it still has a problem (one I found
 in two or three other introductory texts of monads): it stops right
 before getting really interesting!

Along the same lines and subject to many of the same criticisms is
   http://www.engr.mun.ca/~theo/Misc/haskell_and_monads.htm.
Any comments on improving it would be welcome.

Cheers,
Theo Norvell






Re: Wiki Sites (now, haskell.org)

1999-08-23 Thread John Peterson

It's good to see so many people eager to help with haskell.org.  We
have plans for some significant changes at haskell.org and I hope this
will result in a much more open, community developed site.  Andy Gill
and I had a meeting about this at OGI and we will have a new
haskell.org online soon that will be administered jointly by all of
the Haskell community.  I'll be giving accounts to anyone interested
in installing new software, creating new content, or just about
anything else.  

We (well, actually mostly Andy ...) are developing a set of HTML forms that
will interface with a bunch of XML databases.  These forms will
provide a very painless way for any users to submit new libraries, add
new entries to the teaching page, locate people, help build a FAQ, and
anything else we can think of.  Once the new machine gets up and
running I'll make an announcement to this forum and we can start
getting more people on board.  We're hoping to write all of the code
that makes this happen in Haskell and also to use this code as an
example of a real application in Haskell.

Stay tuned ...

  John





Re: A Haskell-Shell

1999-08-23 Thread Carl R. Witty

Heribert Schuetz [EMAIL PROTECTED] writes:

 Hi,
 
 The appended patch to Hugs98 (to be applied in the src subdirectory)
 might be of some help for those who want to do shell scripting in
 Haskell. It modifies IO.openFile as follows:
 
 - If the name of a file opened in ReadMode ends in "|", then the part
   before the "|" is considered a program and its standard output is
   read.
 
 - If the name of a file opened in WriteMode begins with "|", then the
   part after the "|" is considered a program and it is written to its
   standard input.
 
 Several Unix programs have such a behaviour.

I'd recommend against this; it's a potential source of nasty security
holes.  (Suppose somebody uses this version of Hugs to write a system
utility...something like "grep", say.  And then does "cd /tmp; mygrep
whatever *".  And suppose somebody else has created a file named
"/tmp/rm -rf ..|".)

A new function, openFilePipe say, with security warnings in the
documentation, would be better.

Carl Witty





Re: Licenses and Libraries

1999-08-23 Thread Matthias Kilian

   the product. I really do not need any interface to Cobol or
   any other exotic language language but C. This would solve
   most of _my_ problems and for this I would heartily welcome
   anything simpler than H/Direct - no matter whether it came
   from one camp or another.

FYI: There's a tool, SWIG available that eases the construction of interfaces
from C to several languages (Perl, Tcl, Python, Guile, an experimental
interface to Java is also available). AFAIK a new realase of SWIG is planned to
appear in late 1999. This will have more flexible interfaces for new frontends
and backends. Perhaps it is possible to write a backend for Haskell, be it the
FFI used by GHC, be it OMG IDL or whatever.

For more information, see http://www.swig.org.

Kili





Re: Licenses and Libraries

1999-08-23 Thread Jan Skibinski


Several respondents pointed out to me my unfortunate choice
of words, which implied that H/Direct is either related to
MS-specific tools or MS-specific applicability. I apologize
for this.

But H/Direct focuses _also_ on COM, and for this a specific
approach and choice of tools has been made. At least - this
is what I understood from a series of articles on the subject.
Nothing wrong with that save the resulting complexity of
the product. I really do not need any interface to Cobol or
any other exotic language language but C. This would solve
most of _my_ problems and for this I would heartily welcome
anything simpler than H/Direct - no matter whether it came
from one camp or another.

Jan







Re: Monads in plain engllish (Was: Re: Licenses and Libraries)

1999-08-23 Thread Lennart Augustsson

felix wrote:

 Everything just looks
 so darn complicated - even if you are basically just doing the same thing:
 CONS, APPLY,
 and LAMBDA.

Why CONS?  APPLY and LAMBDA is all you need. :-)


--

-- Lennart








Book announcement

1999-08-23 Thread Richard Knott

Dear Sir/Madam,

One of our authors, Chris Okasaki, has asked me to place a book
announcement on your Haskell mailing list for the paperback of his book
Purely Functional Data Structures. The announcement follows: if you have
any questions or would like to make any changes, please contact me.

Yours faithfully,

Richard Knott

Purely Functional Data Structures
Chris Okasaki
Columbia University

Most books on data structures assume an imperative language like C or C++.
However, data structures for these languages do not always translate well
to functional languages such as Standard ML, Haskell, or Scheme. This book
describes data structures from the point of view of functional languages,
with examples, and presents design techniques so that programmers can
develop their own functional data structures.  It includes both classical
data structures, such as red-black trees and binomial queues, and a host of
new data structures developed exclusively for functional languages.  All
source code is given in Standard ML and Haskell, and most of the programs
can easily be adapted to other functional languages. This handy reference
for professional programmers working with functional languages can also be
used as a tutorial or for self-study.

Contents: 1. Introduction; 2. Persistence; 3. Some familiar data structures
in a functional setting; 4. Lazy evaluation; 5. Fundamentals of
amortization; 6. Amortization and persistence via lazy evaluation; 7.
Eliminating amortization; 8. Lazy rebuilding; 9. Numerical representations;
10. Data-structural bootstrapping; 11. Implicit recursive slowdown;
Appendix: Haskell source code.

1998   228 x 152 mm   230pp
0 521 63124 6   Hardback

For further information see http://www.cup.cam.ac.uk or http://www.cup.org


Richard Knott
STM Marketing Dept.
Cambridge University Press
The Edinburgh Building
Cambridge CB2 2RU, UK
email:[EMAIL PROTECTED]
tel: ++44 (0)1223 325916
fax: ++44 (0)1223 315052
Web: http://www.cup.cam.ac.uk