Cheap ForeignPtr allocation

2002-09-02 Thread Simon Marlow
Hi Folks, I'd like to propose two new functions for the ForeignPtr interface: mallocForeignPtr :: Storable a => IO (ForeignPtr a) mallocForeignPtrBytes :: Int -> IO (ForeignPtr a) (the names can change, of course). The implementations are trivial in terms of existing things:

RE: Cheap ForeignPtr allocation

2002-09-02 Thread Simon Marlow
> Can you achieve the same performance gain by adding some > rewrite rules? Perhaps you could try to spot (>>=) malloc (\p -> newForeignPtr p free) Hmmm. Actually I'd like to do both: add the functions, because they encapsulate a common case and guarantee a speed improvement if you us

RE: Cheap ForeignPtr allocation

2002-09-03 Thread Simon Marlow
> I vaguely remeber that in the context of the withForeignPtr > discussion we where once trying to achieve some similar > effect (but couldn't come up with something that would > work). Do you remember? Uh, my memory's a bit vague too :-) For a long time we were trying to get cheap allocation/f

RE: Cheap ForeignPtr allocation

2002-09-04 Thread Simon Marlow
> > Hi Folks, I'd like to propose two new functions for the ForeignPtr > > interface: > > I'm a bit uneasy about this. > > It seems like decisions made on technological grounds (i.e., because > they enable an optimization) tend to date rather quickly because the > technology tends to change to

RE: Cheap ForeignPtr allocation

2002-09-04 Thread Simon Marlow
> > [...] using a ForeignPtr here, with free() as its finalizer, adds so > > much overhead that [...] > > Where is the overhead coming from? Is it the cost of a C call or the > cost of the standard malloc library? It's the combined cost of - malloc() - creating a weak pointer to register t

RE: Proposed change to ForeignPtr

2002-09-04 Thread Simon Marlow
> 1) Add these functions: > > makeForeignPtr >:: Ptr a -> FunPtr (Ptr a -> IO ()) -> IO (ForeignPtr a) > attachForeignPtrFinalizer >:: ForeignPtr a -> FunPtr (Ptr a -> IO ()) -> IO () > >It is implementation defined whether the free functions are allowe

RE: module Data.Bits

2002-09-09 Thread Simon Marlow
> I have just been implementing the library module `Data.Bits' > for nhc98, > as part of an effort to bring that compiler up-to-date with > the latest FFI spec. > > The FFI spec says that the operations called 'shift' and 'rotate', > shift and rotate their argument to the right. However, the G

RE: Updates to FFI spec: performGC

2002-09-10 Thread Simon Marlow
> > > Hmmm, the garbage collector is a black box and has its own > > > complicated heuristics for managing memory usage, but you are > > > describing a mechanism that depends rather heavily on certain > > > assumed behaviours. At the least, that gives the garbage > collector > > > less flexibil

RE: Updates to FFI spec: hs_init() & friends

2002-09-10 Thread Simon Marlow
> So, my proposal is to > > * permit multiple calls to hs_init() and hs_exit() (the > number of calls must match of course), > > * command line arguments specified in the second and > following invocations to hs_init() are ignored, and > > * both arguments to hs_init() may be NULL (to indic

RE: module Data.Bits

2002-09-10 Thread Simon Marlow
> The FFI Addendum actually doesn't commit to which operations > are in the class. It just says defines all these ops to > have a context `Bits a', which is definitely the case. In > other words, you proposed implementation is valid by the > spec and your argument for it makes sense to me. The

RE: Proposed change to ForeignPtr

2002-09-10 Thread Simon Marlow
Malcolm says: > I don't see the problem. The Foogle garbage collector runs separately > and asynchronously to the Haskell GC. A Foogle object is released > by the Haskell collector, then at a later moment in time, a Haskell > object is released by the Foogle collector. Where is the conflict? F

RE: Proposed change to ForeignPtr

2002-09-11 Thread Simon Marlow
I'm afraid George's questions have also rekindled my curiosity about whether implementing Haskell finalizers is really as hard as it sounds. Much has been written, but I still don't think we've got to the nub of the issue. On the face of it, if you can implement 'foreign import ccall safe', then

RE: lightweight struct handling in FFI?

2002-09-19 Thread Simon Marlow
> From: Antony Courtney [mailto:[EMAIL PROTECTED]] > > While the FFI spec. is excellent, I'd really like to see a companion > document with real examples of how to use the FFI for the > easy, obvious > kinds of library interfacing tasks that are likely to arise > in practice. There are quit

RE: ANN: H98 FFI Addendum 1.0, Release Candidate 7

2002-09-19 Thread Simon Marlow
> > > RC 7 of the FFI Addendum is now available from > > > > In adding mallocForeignPtr and friends to Hugs, I found > that I needed > > the address of free to pass as a parameter. > > > > There's no suitable way to generate &free from > MarshalAlloc.free (the > > obvious use of a Haskell wra

RE: addForeignPtrFinalizer

2002-09-24 Thread Simon Marlow
> The spec says there are no guarantees on the order in which > the finalizers > are run. Doesn't this make this function almost impossible to use? > Suppose one finalizer frees the storage and the other cleans > up something > it refers to. I'd suggest running the finalizers in the reverse or

RE: addForeignPtrFinalizer

2002-09-25 Thread Simon Marlow
> On Wed, Sep 25, 2002 at 09:33:04AM +0100, Ross Paterson wrote: > > If the struct were allocated with mallocForeignPtr, you need another > > C call to use as the finalizer for that, say hs_f_free(). > > Sorry, that's wrong: If the struct were allocated with > mallocForeignPtr, > you're stuck.

RE: addForeignPtrFinalizer

2002-09-25 Thread Simon Marlow
> > However, to provide a general ordering property on finalizers would > > be quite awkward in GHC - I just can't think of an easy way to do > > it. [Awkward ways deleted] > > If I understand correctly, the problem is that each FP has a cloud of > finalizer objects attached to it with no partic

RE: addForeignPtrFinalizer

2002-09-25 Thread Simon Marlow
> > I tell you what, I'll implement finalizer ordering if you > guys implement > > full Haskell finalizers :-) > > How about providing newForeignPtr as specified? (Or are you > still hoping?) Still hoping ;-) The discussion seemed to stop without reaching a conclusion last time. At least, I

RE: addForeignPtrFinalizer

2002-09-26 Thread Simon Marlow
> > Actually in the current implementation the finalizers are not > > attached to the ForeignPtr at all: it's the other way around. > > Ah, I see. > > Fortunately, I don't think my sketched implementation depended on such > an attachment since it added an attachment of its own. The design is >

RE: addForeignPtrFinalizer

2002-09-27 Thread Simon Marlow
> > Still hoping ;-) The discussion seemed to stop without reaching a > > conclusion last time. > > I thought it was concluded and the report changed such that all three > compilers which implement the ffi spec can implement it without > receiving a heart, lung and liver transplant. Then I'll re

RE: addForeignPtrFinalizer

2002-09-27 Thread Simon Marlow
> On Fri, Sep 27, 2002 at 12:25:31PM +0100, Simon Marlow wrote: > > Then I'll reformulate my question as a patch. Enclosed is a > > proof-of-concept patch that implements Haskell finalizers > in Hugs, which > > works on some simple tests that I've run

RE: addForeignPtrFinalizer

2002-09-30 Thread Simon Marlow
> > Then I'll reformulate my question as a patch. [...] > > Is there anything fundamentally wrong with this approach? > > I still maintain that getting this to work, testing it and, > especially, maintaining it is a lot of work. Isn't it worth a little effort? Requiring finalizers to be foreign

RE: The Revenge of Finalizers

2002-10-14 Thread Simon Marlow
> > However even if Haskell finalizers + MVars are impossible in NHC, I > > don't think Haskell finalizers + mutable state have to be. For > > example another mutable variable we could have would be a PVar which > > is always full and has functions [snip] > > > updatePVar (PVar ioRef) updateFn

Finali[zs]ers

2002-10-14 Thread Simon Marlow
Thanks to everyone who has contributed to this discussion so far. Since there are a lot of subtle points to be considered at once, I thought I'd try to write a summary of the issues raised so far. I'll put something in the repository so we can all hack on it. Hopefully I'll have something ready

RE: Finalizers etcetera

2002-10-14 Thread Simon Marlow
> I guess the Hugs documentation should say that using unsafePerformIO > to call C which calls Haskell should be avoided. Yes it should, if such behaviour can lead to strange crashes! Better still would be to work out exactly what constraints are required on the use of eval() from primitive ope

RE: Finali[zs]ers

2002-10-14 Thread Simon Marlow
> Thanks to everyone who has contributed to this discussion so > far. Since > there are a lot of subtle points to be considered at once, I > thought I'd > try to write a summary of the issues raised so far. > > I'll put something in the repository so we can all hack on it. > Hopefully I'll ha

RE: Finali[zs]ers

2002-10-14 Thread Simon Marlow
> Thanks to everyone who has contributed to this discussion so > far. Since > there are a lot of subtle points to be considered at once, I > thought I'd > try to write a summary of the issues raised so far. > > I'll put something in the repository so we can all hack on it. > Hopefully I'll hav

RE: [Alastair Reid ] Re: cvs commit: haskell-report/ffi finalizers.txt

2002-10-15 Thread Simon Marlow
> Things you mights add are: > > eg(1) in composite finalizers: > > This would be handled just fine by C finalizers if > addForeignPtrFinalizer guaranteed to execute finalizers in reverse > order of their addition. This seems like a reasonable thing to > specify since addForeignPtrFina

RE: Finali[zs]ers

2002-10-15 Thread Simon Marlow
> I dont have cvs write access but you should mention something about > expressing gc dependencies between ForeignPtr's. the only two > ways to do > this in the current haskell systems are > * weak pointers > * touchForeignPtr from the finalizer of another ForeignPtr Actually I have a feeling th

RE: The Revenge of Finalizers

2002-10-15 Thread Simon Marlow
> > Indeed, I very nearly implemented such a thing as part of the patch > > I sent out. However, it didn't look trivial enough to implement so > > I backed off. The "blocked" state needs to be saved & restored at > > various points: when starting a finalizer, when invoking a > > foreign-exported

RE: The Revenge of Finalizers

2002-10-15 Thread Simon Marlow
> > Also, this is a nested call to eval(), in a primitive, which can > > invoke an IO action and therefore re-enter Haskell without going > > through unsafePerformIO. Is that safe? > > Yes, I think so. Most calls to IO actions from primitives are safe > and I believe these ones are too. (In so

RE: The Revenge of Finalizers

2002-10-15 Thread Simon Marlow
> > So, are we now claiming that my patch *is* safe? (Never mind about > > IORefs, I'm talking about the implementation itself). > > No. Then I'm confused. Allow me to quote your previous message: > Most calls to IO actions from primitives are safe > and I believe these ones are too. So i

RE: The Revenge of Finalizers

2002-10-16 Thread Simon Marlow
> > So is it just that there are a small number of places where it is > > unsafe to invoke IO from a primitive, > > It is unsafe to invoke IO from a prim _in the middle of_ manipulating > a data structure manipulated by IO operations unless the data > structure is designed to allow that nested

RE: The Revenge of Finalizers

2002-10-17 Thread Simon Marlow
> There's another problem with Simon's patch I haven't been able to pin > down: if you run the example, interrupt it at the right point and type > another expression, the finalizers run, but the expression is lost. I can get it to fail another way too: main = do p <- mallocBytes 64 new

RE: C Struct Field Access

2002-10-17 Thread Simon Marlow
> What's the best strategy for accessing fields in someone > else's C struct? > Should I write my own glue file with accessor functions? Or > should I make > a Storable instance for the struct? I wrote some stuff on accessing C structs from Haskell recently which might be useful: http://ww

RE: declaring C enum types

2002-10-17 Thread Simon Marlow
> > > - If not, then how should enum values be declared in the FFI? > > > > What you need to do is run a little autoconf-like program which > > constructs a program containing a suitable example, runs it > through a > > C compiler and tells you what's going on. > > > > hsc comes very close

RE: The Revenge of Finalizers

2002-10-17 Thread Simon Marlow
> I'd hoped that blockFinalizers would be useful for defining other > primitives but since it won't even work for GHC, I agree that PVar > will meet most of our needs. (An even simpler design might be to > extend our IORef implementations with 'atomicallyModifyIORef'.) > > So, is this a design

RE: Why I want Haskell finalizers

2002-10-17 Thread Simon Marlow
> > No, that's only a partial (and indeed very incomplete) solution. It > > relies on the Java GC knowing that that particular reference to the > > Haskell StablePtr is the only one that matters, and vice-versa for > > the Haskell GC. > > So you want StablePtrs to contain a reference count, a n

RE: The Revenge of Finalizers

2002-10-17 Thread Simon Marlow
> > I don't know how to achieve the same goal with > > atomicModifyIORef. > > I do. To modify ioRef1 and ioRef2 "simultaneously", write > > atomicModifyIORef ioRef1 (\ contents1 -> unsafePerformIO > ioRef2 (\ contents2 -> blah blah)) > > The actual modification will take place when the result

RE: The Revenge of Finalizers

2002-10-18 Thread Simon Marlow
> SimonM: > > I can get it to fail another way too: > > > main = do > > p <- mallocBytes 64 > > newForeignPtr p (print x) > > print x > >where > > x = sum [1..1] Alastair: > The problem is probably this shared mutable variable used behind the > scenes in the implementati

RE: The Revenge of Finalizers

2002-10-18 Thread Simon Marlow
> > probably we shouldn't get a crash, but a blackhole instead. > > Even a blackhole is wrong. There's no cycle so it ought to evaluate > successfully. I didn't mean to suggest that a blackhole is correct, sorry for the confusion. No, obviously the code should just work. > > Fixing it so that

Finalizers: conclusion?

2002-10-21 Thread Simon Marlow
Ok, I'm sad to say that the problem we recently uncovered to do with finalizers sharing values with the rest of the program essentially kills off the possibility of doing Haskell finalizers in systems without proper concurrency support. I'm rather embarassed that I didn't notice this before; sorr

RE: Finalizers: conclusion?

2002-10-22 Thread Simon Marlow
> I also need the touchForeignPtr trick in much of my code. we need to > come up with a replacement if we dont have haskell > finalizers. here are my canidate suggestions: > > * add a subset of Weak pointers (or some subset of their > functionality) > to the FFI spec. just get rid of the fina

RE: The Death of Finalizers

2002-10-22 Thread Simon Marlow
> Do we still have atomicModifyIORef? > > I don't know that there's that much point now that Haskell finalizers > are gone. I don't have a strong objection (esp. since it seems every > implementation now has it) but it doesn't seem so necessary now. It ought to be significantly faster than usin

RE: The Death of Finalizers

2002-10-22 Thread Simon Marlow
> | In the meantime, I'm glad we have got a new function > |atomicModifyIORef > | which I for one will use, when it gets into GHC's regular release. > > Just before this gets out of the door... any chance of calling it > > modifyIORef > > and documenting that it's atomic? Sometimes na

RE: The Death of Finalizers

2002-10-22 Thread Simon Marlow
> > It has a different type: > > > > atomicModifyIORef :: IORef a -> (a -> (a,b)) -> IO b > > modifyIORef :: IORef a -> (a -> a) -> IO () > > It would break backwards compatability, but > > modifyIORef_ :: IORef a -> (a -> IO a) -> IO () > modifyIORef :: IORef a -> (a -> IO (a, b

RE: ForeignDependencies: The Semantics

2002-10-23 Thread Simon Marlow
> ack! no with my intended semantics, cycles are not a problem anymore > than they are for weak pointers or the touchForeignPtr method. > everything will still be GCed just like normal. > > (note that these are pretty much exactly the Weak Pointer > semantics, if > you like replace 'ForeignDepen

RE: Finalizers etcetera

2002-10-12 Thread Simon Marlow
> > What hasn't been required is for the various data structures to be > > in a consistent state at that point, and Haskell finalizers might > > trip over those if run after GC. SimonM's patch ran them at a > > different point, though. > > It calls them in eval doesn't it? > eval is called by ne

RE: The Revenge of Finalizers

2002-10-17 Thread Simon Marlow
> Simon Marlow wrote: > [snip] > > Don't you run into a problem even if the two threads use the same > > ordering? Suppose > > > > - thread 1 does the atomicModifyIORef, and gets preempted before > > doing the seq > > - thread 2 does it

RE: The Revenge of Finalizers

2002-10-17 Thread Simon Marlow
> simpleToggle2 :: IORef Bool -> IORef Bool -> IO (Just (Bool,Bool)) > > which attempts to flip the two IORefs from True to False (if > they are both True); > otherwise returning their actual values. Then you could code > this something like this > (no I'm not going to check if it passes GHC) >

RE: The Revenge of Finalizers

2002-10-17 Thread Simon Marlow
> > However in general I think we can hide some of the horribleness from > > the user: > > > modify2IORefs :: IORef a -> IORef b -> (a -> b -> (a,b,c)) -> IO c > > [horrible code deleted] > > And if they need to update 3 IORefs or a list of IORefs? > > Writing code like that yourself and gettin

RE: location of HsFFI.h?

2002-10-30 Thread Simon Marlow
> I was wondering whether there was any standard way to find HsFFI.h? I > can hardcode it into my makefiles for my own projects, but when i > distribute code, I end up having to add -I lines for every possible > location of it, usually multiplied by every compiler version > it supports > since tha

RE: location of HsFFI.h?

2002-10-30 Thread Simon Marlow
> On Wed, Oct 30, 2002 at 09:12:01AM -0000, Simon Marlow wrote: > > If this isn't possible, then you can extract the > information from the > > output of 'ghc -v'. The relevant directory is in the > include_dirs field > > of the rts package. >

RE: ForeignPtr

2002-11-07 Thread Simon Marlow
> Ah, got you. > > How about making ForeignPtr slightly more polymorphic so that > instead of > working only on 'Ptr a' it works on 'a'. > > e.g., We'd have: > > newForeignPtr :: a -> Finalizer a -> IO ForeignThing a Hmm, interesting. This allows the implementation to divorce the object you

RE: ForeignPtr

2002-11-07 Thread Simon Marlow
> That was Ashley's original proposal, but SimonM responded in > > http://www.haskell.org/pipermail/glasgow-haskell-users/2001-September/00 2290.html > http://www.haskell.org/pipermail/glasgow-haskell-users/2001-September/00 2304.html I think I had the wrong end of the stick; or at least I hadn'

RE: ForeignPtr

2002-11-08 Thread Simon Marlow
John Meacham writes: > this already exists in GHC, a side effect of Weak pointers is > that they allow finalizers to be assosiated with any value. > > http://haskell.org/ghc/docs/latest/html/base/System.Mem.Weak.html > > === > addFinalizer :: key -> IO () -> IO () > > A specialised version of

RE: ForeignPtr-related signatures

2002-11-18 Thread Simon Marlow
> Just some small questions: Are we really going to change the > signatures of > newForeignPtr and addForeignPtrFinalizer from those which GHC > has for ages > to the new "C finaliser only" ones? Why don't we use other names and > deprecate the old ones? And what are the plans in this area for G

RE: ForeignPtr-related signatures

2002-11-18 Thread Simon Marlow
> That's what I expected. Would it be possible to include the > new functions > in 5.04.2? OK, that's an API change, too, but simple > additions are rather > harmless. If we don't include this stuff now, there is no > useful common ForeignObj API for GHC/Hugs/NHC in the near future. Ok, I suppo

RE: ForeignPtr-related signatures

2002-11-18 Thread Simon Marlow
> Simon Marlow wrote: > > [...] There was this, from Dean Herrington: > > > > http://haskell.cs.yale.edu/pipermail/ffi/2002-October/000940.html > > > > I don't have any strong feelings (I rarely do, where names are > > concerned). > > I would

RE: MVar interface [was: Re: ForeignPtr-related signatures]

2002-11-19 Thread Simon Marlow
> The current `modifyMVar`, though "exception safe", is not > "atomic" in the > same way that the proposed `atomicModifyMVar` would be. Unless I > misunderstand, during the execution of `modifyMVar`'s second > argument, the > mvar is empty and could be filled by some other thread. With > `atomi

RE: ForeignPtr query

2002-12-04 Thread Simon Marlow
> 1. part of this BDD library uses ints (not pointers) to identify > garbage-collectable objects. there's nothing in the FFI to > cope with this AFAICS. i could: > > - hack the library (but would prefer not to). > > - say the functions in question deal with Ptr CInt, and hope > sizeof(int) > ==

RE: Proposal: Pooled memory management

2003-01-20 Thread Simon Marlow
> Manuel wrote: > > [...] > > * I want to get v1.0 of the spec fixed. We are really only > > in bug fix mode for quite a while and only the finalizer > > problems held us back from finishing the spec. > > That's OK and I understand your motivation. Let's finish v1.0 first. I agree, but I do

RE: Threaded RTS Patch

2003-01-27 Thread Simon Marlow
> I haven't read Hans Boehm's paper (but will try to get a > copy once I am off this plane and have a decent Internet > connection again). While I understand the problems of > running finalizers at program exit, I think the OS plus > explicitly-called-clean-up-routine argument doesn't always > wor

Repeated hs_init()/hs_exit()

2003-01-28 Thread Simon Marlow
I'm implementing the latest hs_init()/hs_exit() interface in GHC, and came across an ambiguity or omission in the spec. We're clear that this sequence should be allowed: hs_init(..) hs_init(..) hs_exit() hs_exit() but what about hs_init(..) hs_exit() hs_init(..) hs_exit() That

RE: Repeated hs_init()/hs_exit()

2003-01-29 Thread Simon Marlow
> Just out of curiosity, what would happen if hs_exit were a noop? if it > left haskell initialized? I imagine there would be a space leak if you > expected the rts's heap storage to be reclaimed, but is there any > user-observable state which would cause programs to behave oddly? Just > curious ma

RE: newForeignPtr

2003-02-03 Thread Simon Marlow
> For a summary of the discussion, see > > http://cvs.haskell.org/cgi-bin/cvsweb.cgi/haskell-report/ffi/finalizers. txt > > However, only Hugs implements this part of the spec at the moment. It will be implemented in GHC before the next major release. I'm not intentionally dragging my heels on t

RE: newForeignPtr

2003-02-03 Thread Simon Marlow
> "Simon Marlow" <[EMAIL PROTECTED]> writes: > > > > However, only Hugs implements this part of the spec at the moment. > > > > It will be implemented in GHC before the next major > release. I'm not > > intentionally dragging my he

RE: safe and threadsafe

2003-02-07 Thread Simon Marlow
> I don't think it was ever the intention that 'safe' should have a > guaranteed serialisation property. I think the idea was that > 'threadsafe' was the most desirable, with 'safe' and 'unsafe' only > available for use if you wanted more efficiency and had some separate > guarantees that the extr

RE: Bound Threads

2003-03-14 Thread Simon Marlow
> I have just spend some time reading through all the > discussions and the > new "threads" document and I would like to propose the > addition of a new library function. > > > forkOS :: IO () -> IO ThreadID > > The function "forkOS" forks a new Haskell thread that runs in > a new OS (or > nat

ForeignPtr naming

2003-03-19 Thread Simon Marlow
I'm just getting around to converting GHC's ForeignPtr to match the spec once more. This is all fine, except that implementing finalizer ordering slows down ForeignPtrs quite a bit, in particular mallocForeignPtr takes a 20% hit just allocating the IORef needed to store the list of finalizers.

RE: ForeignPtr naming

2003-03-20 Thread Simon Marlow
> > This is all fine, except that implementing finalizer ordering slows > > down ForeignPtrs quite a bit, in particular mallocForeignPtr takes a > > 20% hit just allocating the IORef needed to store the list of > > finalizers. Ideas for a better implementation are welcome. > > Having obviously op

RE: ForeignPtr naming

2003-03-26 Thread Simon Marlow
> As Haskell finalizers need pre-emptive concurrency, maybe > they should go somewhere related to concurrency. Or we > could have a "Foreign.Concurrent". Ok, how about Foreign.Concurrent.newForeignPtr and Foreign.Concurrent.addForeignPtrFinalizer? i.e. dodging the naming issue by using the modu

RE: How to access defines and enums in a convenient way?

2003-06-06 Thread Simon Marlow
> I am doing some wrappers for c functions, and I need to > access defines, enums, and structs. > > I am doing this by writing access functions in c, so that I can call > them from Haskell. > > Is there a way to write this c code inline in the Haskell > module? You want to use a tool to make

RE: ANN: H98 FFI Addendum 1.0, Release Candidate 10

2003-05-28 Thread Simon Marlow
> Manuel M T Chakravarty <[EMAIL PROTECTED]> writes: > > > -=- Changes since RC 9 > > > > * 6.2: All the types in CTypes must be newtypes that are exported > > abstractly. > > This change makes things highly inconvenient in nhc98. A newtype > can only be passed across the FFI in n

RE: Allocation & Marshalling Question (again)

2003-05-28 Thread Simon Marlow
> Judging by the silence that greeted my last posts re this a > couple of weeks > ago I suspect this is of no interest to anyone but me :-( > > An extra couple of weeks cogitation on this hasn't really > changed MHO much > (other than I'm no longer so pessimistic about the safety of > my <+ o

RE: Allocation & Marshalling Question (again)

2003-05-29 Thread Simon Marlow
> On Wednesday 28 May 2003 10:32, Simon Marlow wrote: > > > Even in GHC where we use garbage collected memory instead > of malloc, we > > still make use of the IO monad to control the lifetime of > the allocated > > memory. > > Thanks for that i

RE: ANN: H98 FFI Addendum 1.0, Release Candidate 10

2003-06-02 Thread Simon Marlow
> I don't think we have much choice about whether undefined > values are part of > the type. If you can create a value of that type: > > x <- derefPtr (px :: Ptr T) I'm not following this. what exactly is derefPtr? The only analogous function I can think of is Foreign.peek: peek :: Sto

RE: ANN: H98 FFI Addendum 1.0, Release Candidate 10

2003-06-02 Thread Simon Marlow
> > I'm not following this. what exactly is derefPtr? The only > analogous > > function I can think of is Foreign.peek: > > Sorry, I meant peek. > > > but peek will unmarshal the value at the end of the Ptr into T, so T > > cannot be abstract. > > Sorry, I was just trying to show how to crea

RE: ANN: H98 FFI Addendum 1.0, Release Candidate 10

2003-06-02 Thread Simon Marlow
> On 02-Jun-2003, Simon Marlow <[EMAIL PROTECTED]> wrote: > > > > I can't see how to acquire a value of type T that isn't bottom. > > By calling a function defined using the FFI, of course. But the FFI lists the types that may be returned by a foreign fun

RE: ANN: H98 FFI Addendum 1.0, Release Candidate 10

2003-06-03 Thread Simon Marlow
> Using `newtype T = MkT Int8' or equivalent only works for foreign data > types whose representation is known. How do you deal with > C's "time_t", > for example? Or with C "struct" types? The user doesn't want to make > non-portable assumptions about what padding the C compiler is going > t

RE: ANN: H98 FFI Addendum 1.0, Release Candidate 10

2003-06-03 Thread Simon Marlow
Alastair Reid writes: > I strongly agree that we should definitely add the ability to > declare types > whose definition is provided externally. (i.e., provide the > feature that empty datatype decls currently provide.) > > Before adding them, we need to agree on the semantics and > syntax (

RE: ANN: H98 FFI Addendum 1.0, Release Candidate 10

2003-06-03 Thread Simon Marlow
> On Monday 02 June 2003 2:32 pm, Simon Marlow wrote: > > > Ok. But I still don't understand why the whole discussion > isn't moot. > > I can't see how to acquire a value of type T that isn't bottom. > > Whether you can acquire values of this

RE: ANN: H98 FFI Addendum 1.0, Release Candidate 10

2003-06-03 Thread Simon Marlow
> We routinely use code like this: > > data Point > foreign import getMousePos :: Ptr Point -> IO () > foreign import getX :: Ptr Point -> IO Int > foreign import getY :: Ptr Point -> IO Int > > The idea being that: > > 1) there is a foreign type (which might be called Point, > MousePo

RE: ANN: H98 FFI Addendum 1.0, Release Candidate 10

2003-06-05 Thread Simon Marlow
> > > > data Point > > > > foreign import getMousePos :: Ptr Point -> IO () > > > > foreign import getX :: Ptr Point -> IO Int > > > > foreign import getY :: Ptr Point -> IO Int > > vs > > > data Point = Point (Ptr Point) > > foreign import getMousePos :: Point -> IO () > > I lik

RE: exercising the storage manager

2003-06-10 Thread Simon Marlow
> g'day everyone, > > I'm getting segv's from a program using the FFI (ghc5.0x) on > MacOS X only, > i.e. not on Linux, my primary development platform. > > So... does anyone have any tips for showing up dodgy uses of > the FFI wrt > memory handling? What settings for GHC's garbage collector

RE: stdcall

2003-07-22 Thread Simon Marlow
> On Saturday 19 July 2003 12:51 am, Ross Paterson wrote: > > Could the meaning of stdcall be broadened to "the standard calling > > convention for libraries on the native system", i.e. pascal on Win32 > > (as now) and ccall on Unix? It would save a lot of fuss > for interfaces > > to portable

RE: The Errno Story

2003-07-25 Thread Simon Marlow
John Meacham writes: > I am not a fan of having to stow errno for every ffi call.. As was pointed out to me last time this came up, you don't have to stow it for every FFI call, only on a context switch. Adding one word to a TSO is also very cheap. The total cost is almost certainly unmeasura

RE: The Errno Story

2003-07-25 Thread Simon Marlow
> I therefore propose that we make the RTS save & restore the value of > errno in the TSO, thus making errno "Haskell-Thread-Local-State", and > solving all of the above problems. Actually this has been on my ToDo list for a long time, I just never got around to doing it (it has been mentioned

RE: CWString

2003-08-26 Thread Simon Marlow
> Attached is a properly internationalized implementation of > Foreign.C.String, along with some other routines which I feel would be > very at home in the FFI standard. I support this proposal. > Note that I am trying to solve a simpler problem than full > generic i18n. > I just want the abil

RE: CWString

2003-08-27 Thread Simon Marlow
> > > In our new implementation of Data.Char.isUpper and > friends, I made the > > > simplifying assumption that Char==wchar_t==Unicode. With > glibc, this > > > appears to be valid as long as (a) you set LANG to > something other than > > > "C" or "POSIX", and (b) you call setlocale() first.

RE: CWString

2003-08-27 Thread Simon Marlow
> hmm.. how odd. I would consider it a bug, I think. I don't have a copy > of the ISO spec handy but will be sure to look up whether that is > conforming... It is certainly a malfeature if it is not a bug... I fired off a message to [EMAIL PROTECTED], we'll see what they have to say. Cheers,

RE: CWString

2003-08-28 Thread Simon Marlow
> 3) link against another library such as libunicode which provides its > own classification routines (this could be done optionally at compile > time...) libunicode is no good, I tried it. It only recognises Unicode characters up to '\x'. The only right way to do this, it seems, is to gen

RE: Errors from Haskell, C/C++ Objects Linkage

2003-09-03 Thread Simon Marlow
> When linking a program with Haskell Code (also the main program), > and interfacing to C functions (a lib*.a C++ application > library is also combined), > the following error occurs: > > c:/ghc/ghc-6.0/libHSrts.a(Main.o)(.text+0x86):Main.c: > undefined reference to > `__stginit_Main' > c:/g

RE: ANN: H98 FFI Addendum 1.0, Release Candidate 13

2003-11-05 Thread Simon Marlow
> I have put RC 14 at > > http://www.cse.unsw.edu.au/~chak/haskell/ffi/ > > including all the feedback on RC13. Please especially have > a look at Section 6.3 (Section "CString"), where some of the > wording changed. The spec is silent on how exactly a Haskell Char is translated to a CWchar

RE: H98 FFI Addendum 1.0, Release Candidate 15

2003-11-12 Thread Simon Marlow
> And here now a probably naive question of mine: Does the > notion of Marlow sensibility coincide with platforms that > follow ISO/IEC 10646? We don't want to restrict the standard to sensible systems, because that rules out Windows :-). On Windows, wchar_t is UTF-16, which is a profoundly sil

RE: H98 FFI Addendum 1.0, Release Candidate 15

2003-11-14 Thread Simon Marlow
> On Fri, Nov 14, 2003 at 01:57:41PM +1100, Manuel M T > Chakravarty wrote: > > These marshalling routines convert Haskell's Unicode > > representation for characters into the platform-specific > > encoding used for \code{wchar\_t} and vice versa. In > > particular, on platforms that re

RE: How to force finalization of ForeignPtr

2003-12-22 Thread Simon Marlow
[ forwarded to [EMAIL PROTECTED] ] >In the current implementation there is no way to > force finalization of the foreign ptr if there are > still references to it. In this scenario > the finalization will be executed during the next > garbage collection. In some cases it is known that the >

newtype abstraction problem

2004-02-04 Thread Simon Marlow
Simon & I just uncovered a slight problem with the FFI spec. It is legal to use a newtype as an argument type (Section 3.2, the FFI spec uses the term "renamed datatype" to mean newtype here). It doesn't say whether the newtype has to be in scope non-abstractly or not - indeed the intention seems

RE: Request: withArrayLength

2004-03-23 Thread Simon Marlow
> I think we need to decide how the further development of the FFI will > proceed. Given that Version 1.0 of the Addendum is frozen, I > am not in > favour of changing the Addendum anytime soon and certainly > not for small > matters, such as a convenience function. > > We might want to accum

RE: Request: withArrayLength

2004-03-24 Thread Simon Marlow
> I think adding new (hierarchical) modules is the way to go for now. > > 1) Hierarchical because it lets us use some nice clear >module naming style like: > > Foreign.NonStd.* >or > Foreign.Extension.* > >[I favour the former since the status of the lib is clearer.] Not

<    1   2   3   >