ayrnieu changed the topic of #ocaml to: OCaml 3.08.4 available! Archive of Caml Weekly News: http://sardes.inrialpes.fr/~aschmitt/cwn/ | A free book: http://cristal.inria.fr/~remy/cours/appsem/ | Mailing List: http://caml.inria.fr/bin/wilma/caml-list/ | Cookbook: http://pleac.sourceforge.net/
<twobitsprite> how do I test to see if two values are of the same type constructor? I.e. how do I compair varients other than match, i.e. arbitrarily...
mlh_ has joined #ocaml
<twobitsprite> hmm... better yet... is there a way to extract a string representing the type of a value?
<Smerdyakov> Any comparison method that appears not to use pattern matching is actually implemented in terms of pattern matching. It is the primitive construct for using variants.
<Smerdyakov> And there is no dynamic type information in ML.
ecc has quit ["Client exiting"]
ellism has left #ocaml []
vodka-goo has quit [Read error: 145 (Connection timed out)]
vodka-goo has joined #ocaml
lispy` has joined #ocaml
<lispy`> ping
vezenchio has joined #ocaml
<Smerdyakov> WTF man
<lispy`> me?
<Smerdyakov> Yes
<lispy`> sorry, was just trying to say hi :)
<Smerdyakov> I am so busy right now! Why are you disturbing me??
<lispy`> ;)
<lispy`> just put me on /ignore :)
threeve has joined #ocaml
<twobitsprite> lkasjdflaskjf
<twobitsprite> I'm trying to implement a brainfuck interpreter, but I can't for the life of me get it to work!! :(
<twobitsprite> I'm rewriten in 3 times, 3 different ways, and I always seem to get similar problems...
<twobitsprite> s/I'm/I've/
scruffie has joined #ocaml
<twobitsprite> anyone care to take the time to glance at my (hopefully not too ugly) code?
pango__ has joined #ocaml
<twobitsprite> pango__!! help me! :(
<twobitsprite> I'm lost in untraceable bug hell
pango_ has quit [Read error: 110 (Connection timed out)]
<lispy`> anyone know of a nice object-relational model for ocaml? hopefully one that uses some sort of reflection at run-time so that it's transparent to use
<twobitsprite> I compiled my program as "ocamlc -g -o test test.ml" and ran the debugger as "ocamldebug test" and try "step 0", but it just runs the whole program and says "Time : 696381\nProgram end.\nUncaught exception..."
<twobitsprite> why is it not stepping?
<lispy`> could it be the uncaught exception? (i've never used the debugger)
<twobitsprite> the exception isn't thrown until the program has gone through several thousand instructions...
<twobitsprite> there has to be somewhere between the beginning of the program and the 100000th instruction that it can step to...
<lispy`> does step 1 fair any better?
threeve has quit []
<twobitsprite> it does indeed! :P th docs online say to use step 0...
<lispy`> cool
<twobitsprite> excellent, thanks :)
<lispy`> typical of computer scientists to be off by one :)
<twobitsprite> lol
<twobitsprite> hmm.. you know how to get the size of a file in ocaml?
<mfurr> Unix.stat?
<twobitsprite> ahh, there it is... hmm
<twobitsprite> is pattern matching the only way to extract a single value from a record?
<Smerdyakov> No. Read the manual on records.
* twobitsprite is searching
<Smerdyakov> You shouldn't need to "search" very hard. The language reference is very compact.
<twobitsprite> Smerdyakov: I'm sorry, I'm not seeing it... maybe I'm just not very bright
<Smerdyakov> Which part of the manual do you think is the language reference?
<twobitsprite> "The Objective Caml language" link under Part III
<Smerdyakov> Do you mean Part II?
<twobitsprite> er, yes, sorry.
<twobitsprite> (it's getting late, my eyes are crossing :P)
<Smerdyakov> And what procedure did you use for searching for this information, within that section?
<twobitsprite> I used some intuition to try to determine which subsection it would be in... I checked "Values" "Expressions" and "Patterns"...
<twobitsprite> Expressions has a bit about defining and constructing records, but I didn't see anything about extracting a member from one...
<Smerdyakov> Look again.
<twobitsprite> I know it's staring me in the face somewhere...
<Smerdyakov> There is a section called "Records" which you apparently didn't read very carefully.
<twobitsprite> under the "records" title?
* twobitsprite face-palms and admits his blindness
<twobitsprite> maybe I should just go to bed, I'm obviously loosing focus...
vodka-goo has quit [Read error: 60 (Operation timed out)]
Nutssh has quit ["Client exiting"]
ski has joined #ocaml
ski_ has joined #ocaml
ski has quit [Nick collision from services.]
ski_ is now known as ski
Maldoror has joined #ocaml
Skal has joined #ocaml
Nutssh has joined #ocaml
ptolomy has quit [Read error: 110 (Connection timed out)]
scruffie has quit []
<pango__> twobitsprite: I don't think there's a general way check that two values use the same constructor (nor that it would be very useful in a general way)
<pango__> match a,b with
<pango__> | Constructor1 _, Constructor1 _ | Constructor2 _, Constructor2 _ -> do_something ...
tom_p has quit [Read error: 113 (No route to host)]
ski_ has joined #ocaml
ski has quit [Nick collision from services.]
ski_ is now known as ski
tom_p has joined #ocaml
pango__ has quit [Read error: 54 (Connection reset by peer)]
pango has joined #ocaml
batdog is now known as batdog|gone
batdog|gone has quit [Read error: 104 (Connection reset by peer)]
batdog|gone has joined #ocaml
m3ga has joined #ocaml
revision17_ has joined #ocaml
mlh_ has quit [Client Quit]
Nutssh has quit ["Client exiting"]
smimou has joined #ocaml
Revision17 has quit [Read error: 110 (Connection timed out)]
ski_ has joined #ocaml
ski has quit [Nick collision from services.]
ski_ is now known as ski
__DL__ has joined #ocaml
<haakonn> i'm a bit stuck here. i have module with data stored in a type 'a t, which is a triple of a "'a Set" and two 'a lists. how do i express the Set type correctly? and how do i "Make" the Set, given that I don't know what type the 'a actually is?
<haakonn> i don't want to expose the type by the way, so the user doesn't know there is a Set involved
<Demitar> Perhaps type 'a t = 'a Set.t * 'a list * 'a list (and type 'a t in the signature) given I've properly interpreted your question.
Submarine has quit ["Leaving"]
Schmurtz has joined #ocaml
<haakonn> well, "Unbound type constructor Set.t"
<haakonn> also tried Set.Make.t, Set.S.t
<Schmurtz> hmmm...
<Schmurtz> module aaa = Set.Make(your type);;
<Schmurtz> aaa.t;;
<Schmurtz> the "Make" object is a functor : a kind a function transforming a module into anoter
<haakonn> but how can i make the module to feed to Set.Make when i don't know the type exactly?
<Schmurtz> another module
<Schmurtz> to want to stored object of several types in a set ?
<Schmurtz> (you want...)
<haakonn> no, i just want to store 'a values in it
<Schmurtz> I think it's not possible
<haakonn> hmm.
<Demitar> Well, it might be.
<Demitar> Given that we have polymorphic comparison functions.
<haakonn> yes, but i have to declare the ordering module before i declare my 'a t somehow
<haakonn> just a regular polymorphic, non-functorial Set would have been a lot easier :)
<Demitar> You can always use Hashtbl. instead.
<haakonn> less natural, but i could
<Schmurtz> haakonn, some other people have asked for it on the official caml list
<Demitar> And where it breaks down is that type 'a t isn't included in type t (which is needed by the orderedtype).
<Schmurtz> I don't remember the reasons why it has been refused
<haakonn> Schmurtz: well the ocaml devs have good reasons for everything :)
<Demitar> No doubt there already is one in ExtLib. :)
<Schmurtz> in this case, it would have been useful to have a non functor based Set
<haakonn> extlib has PMap, but no PSet
<haakonn> my kind of case can't be that rare though
<haakonn> Schmurtz: interesting, thanks
<haakonn> looks like i'll end up with a ('a, unit) PMap.t, since i already depend on PMap
rossberg has quit [Success]
rossberg has joined #ocaml
ski has quit [Read error: 104 (Connection reset by peer)]
Submarine has joined #ocaml
threeve has joined #ocaml
m3ga has quit ["disappearing into the sunset"]
batdog|gone has quit [Remote closed the connection]
batdog has joined #ocaml
mellum has left #ocaml []
vodka-goo has joined #ocaml
mikeX has joined #ocaml
<pango> what's memory usage of Int32s ? I know they're boxed, so they must use at least 2 words on 32 bits archs, but is that all ?
<Smerdyakov> Try writing a program which allocates a lot of them and keeps them live, and measure the memory usage?
<pango> I was trying to save some time ;)
<Smerdyakov> And you will almost certainly find that it uses more than two words.
<Smerdyakov> There's probably some header before each object in the heap.
<pango> yes, most probably
<Smerdyakov> My advice? Switch to SML and MLton. Unboxed 32-bit integers are your God-given right. ;)
<pango> it's for an existing big project, so it's not an option
<haelix> Smerdyakov: Do you have any clue as to how SML and MLton perform their garbage collection, with suh unboxed 32-bits integer ?
<haelix> special non-pointer heap ?
<Smerdyakov> haelix, it's standard for each heap object to have a tag describing which of its fields are pointers, even in OCaml, I think.
<Smerdyakov> haelix, and MLton executables have a table mapping registers and stack slots to types for each point where GC might occur.
<pango> Smerdyakov: "what fields are pointers" is what the bit 0 is for, I think
<Smerdyakov> pango, maybe OCaml doesn't do it, but I know MLton does.
<Smerdyakov> pango, the trouble comes if you want to support non-word-sized objects, like floats.
<Smerdyakov> pango, to allow floats in records, I'm pretty sure OCaml needs some special mechanism.
<Smerdyakov> pango, and that's probably object descriptions in headers.
<pango> Smerdyakov: records of floats and arrays of floats are special
<haelix> Smerdyakov: thanks for the kind sharing of knowledge
twobitsprite has quit ["Lost terminal"]
<Schmurtz> pango, I would say one Int32 use 3 bytes :
<Schmurtz> 1 for the pointer to the Int32 structure
<pango> 3 words I guess
<Schmurtz> 3 words, yes
<Schmurtz> 1 for the Int32 magic type
<Schmurtz> 1 for the number
ecc has joined #ocaml
<pango> Schmurtz: testing gives something more close to 4
<pango> let _ =
<pango> let x = Array.make .... Int32.zero in
<pango> ignore(read_line ())
<pango> 1e6 => 1204 petchema 17 0 6024 4380 1548 S 0.0 1.1 0:00 ./test
<pango> 2e6 => 1315 petchema 18 0 9932 8292 1548 S 1.8 2.1 0:00 ./test
<pango> 3e6 => 1362 petchema 18 0 13836 11m 1548 S 0.4 3.2 0:00 ./test
<pango> 4e6 => 1407 petchema 20 0 17744 15m 1548 S 7.2 4.2 0:00 ./test
<pango> interesting, I tried using Int32s instead of int*int*int*int to save IPv4 numbers, but memory usage seems to be exactly the same...
<Schmurtz> ok
<Schmurtz> Int32 is definitely not optimal
<pango> what could be more compact to save 32 bits values ?
<Schmurtz> 2 int
<Schmurtz> :)
<pango> that's worth a try
<Schmurtz> but it's not easy to add or multiply 32bits values in this cas
<Schmurtz> it must be more than 1 32bit word
<Schmurtz> so the minimum size for storing a 32 bits value is 2 32b words
<Schmurtz> (is you use a pair int * int, it may add a small overhead)
<pango> Schmurtz: I don't play to multiply IPv4 numbers for now ;)
<pango> s/play/plan/
<Schmurtz> :)
<Schmurtz> if you don't store thousands of IPv4 adresses in memory, Int32 is sufficient
<pango> I do
<Schmurtz> how many IPs ?
<pango> usually few 10's of thousands
<pango> eh, int*int use just as much memory :)
<Schmurtz> so 100 000*4*4 = 1Mo
<Schmurtz> not very much
<pango> yes, I bet I'll have to profile other structures too
<Schmurtz> ocaml is not a good langage for that
<Schmurtz> it waste much memory
<Schmurtz> :(
<Schmurtz> I don't have a long experience of ocaml, but I think the best solution it to write a small library in C to handle memory storage for each structures
<pango> well, memory is cheap, and memory usage is already ok for most users... just checking if anything could be improved with little hassle
<Schmurtz> so... good luck
<pango> Fabrice Le Fessant wrote a compiler patch for memory profiling
<pango> but I haven't used it yet
<Schmurtz> I'm interesting
<Schmurtz> I've worked on a project working on very big graphs
<Schmurtz> memory usage was one of the main issues
<Schmurtz> (file parsing was the second one)
<Schmurtz> It make me think that ocaml is not good to work with very big data structures
<pango> look for memprof-ocaml
<Schmurtz> lol, I've discovered that Fabrice Le Fessant is a teacher in my university :)
descender has quit ["int main() { return main(); }"]
descender has joined #ocaml
<lispy`> why would ocaml be worse than other languages with big structures?
<Schmurtz> lispy`, because for things like Int32, it uses 4 times the memory used by C
<lispy`> er, really? why?
<Schmurtz> the same thing occured with floats
<Schmurtz> caml use only 2 low level types :
<Schmurtz> - 31bits integers
<Schmurtz> - 31
mikeX has quit ["Leaving"]
<Schmurtz> - pointers to structures
<Schmurtz> structures start with a magic code indentifying their types
<lispy`> and int32 requires 16bytes?
<Schmurtz> yes
<lispy`> wow
<Schmurtz> so if you use a float int32 you need :
<Schmurtz> - on pointer to the int32 structure
<Schmurtz> one
<Schmurtz> - a 32bits magic code identifying the float type
<Schmurtz> - 64 bit for the float value
<Schmurtz> oups, 32 bit for the int32 value
<Schmurtz> so, you need at least 3*32bits
<Schmurtz> according to pango tests, it use 4 * 32 bits
<pango> I guess there's another because it's "enclosed" in a "dynamic block on one element"
<Schmurtz> pango, perhaps
<pango> it would waste less memory to gather several In32s together, but then you get a problem of internal fragmentation
<Schmurtz> one solution may be to use Bigarray : one 32bit integer takes exactly 32bits
<pango> saw that too, but then you have to manage allocation yourself, they're not weak arrays or anything :/
pango has quit ["brb"]
pango has joined #ocaml
cmeme has quit ["Client terminated by server"]
cmeme has joined #ocaml
pnou has quit ["brb"]
pnou has joined #ocaml
pango has quit [Read error: 60 (Operation timed out)]
pango has joined #ocaml
pnou has quit ["leaving"]
pnou has joined #ocaml
pnou has quit [Client Quit]
pnou has joined #ocaml
vezenchio has quit [""The law, in its majestic equality, forbids the rich as well as the poor to sleep under bridges, to beg in the streets, and t]
Snark has joined #ocaml
Gueben has joined #ocaml
Msandin has joined #ocaml
__DL__ has quit [Remote closed the connection]
Snark has quit ["Leaving"]
Msandin has quit [Read error: 110 (Connection timed out)]
Schmurtz is now known as LENOUVONICK
LENOUVONICK is now known as schmurtz
threeve has quit []
schmurtz has quit []
Schmurtz has joined #ocaml
mrsolo has joined #ocaml
rt has quit ["Download Gaim: http://gaim.sourceforge.net/"]
Gueben has quit [Remote closed the connection]
dmuino has joined #ocaml
mikeX has joined #ocaml
Skal has quit [Remote closed the connection]
vodka-goo has quit []
lightstep has joined #ocaml
mikeX has quit ["Leaving"]