Banana changed the topic of #ocaml to: OCaml 3.08.1 available! | Archive of Caml Weekly News: http://sardes.inrialpes.fr/~aschmitt/cwn/ | A tutorial: http://merjis.com/richj/computers/ocaml/tutorial/ | 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/
<mrvn_> I prefer it not to inline. I don't want code duplication for every instnce of a functor.
<vincenz> usrj
<vincenz> yeah
<vincenz> I googled
<vincenz> ocaml doesn't inline accross functors
<mrvn_> Its one huge drawback of templates in c++.
<vincenz> mrvn_: depends on your usage
<mrvn_> sure.
<vincenz> for mixins it's perfect
<mrvn_> If you have 20 different mixins you end up with 20 times the code.
<vincenz> not really
<mrvn_> Each mixin gets the complete template code copied.
<kinners> there's a program called ocamldefun which does a source-to-source transformation to remove the functors, but I think it's unmaintained
<vincenz> mrvn_: well since I only use the top mixin, that's simple question of dead-code removal
<monochrom> ocamldefunct :)
<vincenz> monochrom: thnx :)
<mrvn_> sound defunct.
<vincenz> can't find it ong oogle
<mrvn_> sounds
<monochrom> I was kidding about the name ocamldefun.
<vincenz> ah
<monochrom> (and its dormant status)
<vincenz> 3.06
<vincenz> o_O
<vincenz> I don't see why ml doesn't inline accross functors tho
<vincenz> either way, I have to transform to modules from oo first anyways
FredH has joined #ocaml
<FredH> Is this a perl channel
<vincenz> FredH: yes, hence the obvious name "ocaml"
grirgz_ is now known as grirgz
clog has joined #ocaml
<vincenz> is there a way not to use compare_val when comparing int64's?
* vincenz palmslaps
<mrvn_> don#t use int64's.
<vincenz> well then I'll use int32s
<vincenz> either way
<mrvn_> vincenz: let process_all_access data = Super.process_all_access data.super
<vincenz> it's raelly stupuid
<vincenz> I looked at the source andt here are compare functions in the .c's
<vincenz> but they're not exported
<mrvn_> That means you have some code there that looks up the super member of data and calls another function.
<vincenz> and so Int64 and Int32 use Pervasives.compare
<vincenz> mrvn_: yup
<mrvn_> In C one would make data.super the first element in the data structure and then one could use the same pointer.
<vincenz> in ocaml there's no such thing as pointers
<vincenz> ugh
<vincenz> why doesn't the .c of ocaml export the cmp functions!
<mrvn_> vincenz: sure there is. Pretty much everything is a pointer.
<mrvn_> vincenz: A memcmp is probably just as fast.
<vincenz> mrvn_: well if I write a .c
<vincenz> I'll just use the code they use in their .c, I just find it stupid that they don't export it
<mrvn_> Why do you need int64.t?
<Nutssh> Code duplication can also slow things down because it puts more pressure on the caches.
<vincenz> from int32.ml
<vincenz> let compare = (Pervasives.compare: t -> t -> int)
<vincenz> Nutssh: every derefence on call does the same thing, except that instruction caches are usually better made for such things
<vincenz> mrvn_: well int32 will suffice
<mrvn_> vincenz: why not int?
<vincenz> cause it represents memory-addresses
<Nutssh> Code duplication... Can you do what you want by using functors and, if necessary, a defunctorizer?
<mrvn_> My int is far bigger than Int32.t
<vincenz> mrvn_: what machine do you have?
<mrvn_> amd64
<vincenz> well then your int is smaller than the address range of your pc
<mrvn_> and alpha
<mrvn_> it is always smaller.
<vincenz> just that for you it's int64 for me it's int32
<vincenz> why oh why don't they export the cmp functions
* vincenz mutters
<mrvn_> Nah, int would suffice. The top part of the 64bit isn't usable.
<mrvn_> vincenz: because it is slower
<vincenz> mrvn_: no it's not, Pervasives.compare is slower
<vincenz> DOH
<vincenz> DOH DOHG
<vincenz> from ints.c in the distro
<vincenz> let compare = (Pervasives.compare: t -> t -> int)
<vincenz> I mean
<vincenz> CAMLprim value caml_int32_compare(value v1, value v2)
<vincenz> that previous was from int32.ml
<vincenz> why don't they use caml_int32_compare ?!?
* vincenz mutters
<vincenz> they have one for int64 as well
<vincenz> but in the .mls they use Pervasives.compare
mrsolo_ has quit ["Leaving"]
<mrvn_> The C code will most likely be slower.
<vincenz> what makes you say that?
<vincenz> Pervasives.compare calls compare_val (C-function)
<vincenz> which switches on type
<vincenz> a function that knows the type is inherently going to be faster
<mrvn_> because there is nothing you can do then compare it wordwise and Pervasives will be in cache more often from other compares.
<Nutssh> vincenz, what does the profile indicate being the biggest problem? What does oprofile. For one of my performance problems with compare_val, fixing it was as simple as putting in a ': int' in two places.
<vincenz> Nutssh: compare_val
<Nutssh> Where is it being called from?
<vincenz> Nutssh: I already did the :int where possible
<vincenz> Nutssh: maps
<Nutssh> Ah. I had that too.
<vincenz> 16.11 1600.62 1600.62 3621570446 0.00 0.00 compare_val
<vincenz> anyways
<Nutssh> My fix was copy and paste maps.ml into intMaps.ml and put in the int declarations there.
<vincenz> I made my modules that use int32
<vincenz> instead of using Int32.compare
<vincenz> I had
<mrvn_> vincenz: that might be a lot of compares from your maps.
<vincenz> external : int32 -> int32 ->t = "caml_int32_compare"
<Nutssh> 'Int32.t' is *much* more expensive than 'int'
<vincenz> I NEED int32's
<vincenz> I told you
<Nutssh> What are you doing with them that needs them?
<vincenz> I'm working with memory-addresses
<Nutssh> Ah.
<mrvn_> vincenz: and you can't limit the addresses to 2 GB?
<vincenz> this is from a c++-program logfile taht logs all the accesses
<vincenz> mrvn_: no
<vincenz> mrvn_: stack usually resides at 0x08
<vincenz> and heap usually at somewhere else
<vincenz> (actually reverse that)
<mrvn_> vincenz: The top 2GB are usualy reserved for the kernel.
<vincenz> mrvn_: well this will have to work in many places
<vincenz> so I can't make such assumptions
<vincenz> aka, windows
<mrvn_> But that is where you will loose the most speed. an extra pointer on every int32
<mrvn_> no register variables and such
<vincenz> well I was losing more speed before
<vincenz> as it was using compare_val
<vincenz> which switches on type
<mrvn_> every Int32.t operation allocates new memory.
<vincenz> I'm reprofiling now
<vincenz> mrvn_: I know
<Nutssh> What are you doing with the memmory addresses in your program?
mrsolo has joined #ocaml
<vincenz> Nutssh: many things
<Nutssh> Like?
<vincenz> whenever I get a log-packet that says a block was allocated I added it tomy block-map
<vincenz> then whenever Ihave a memory access I find which block it is
<vincenz> so I know what block-size was accessed
<vincenz> for instance
<vincenz> I haev a special compare function for that
<vincenz> (that's something that can not be done with hashes)
<vincenz> let compare (b1, e1) (b2, e2) =
<vincenz> let c1 = Address.compare e1 b2 in if c1 <= 0 then -1 else
<vincenz> let c2 = Address.compare e2 b1 in if c2 <= 0 then 1 else 0
<vincenz> (I know blocks will never be overlappeable)
<mrvn_> You could just reduce granularity and divide all addresses by 2.
<Nutssh> Divide all addresses by 8 so they fit in the 'int' type, and fixup the details if necessary? Unless the gain is worth the effort, is this worth optimizing?
<vincenz> mrvn_: I'm not sure all addresses are evene
<vincenz> Nutssh: you mean by 2
<mrvn_> vincenz: So? on char accesses two chars will fall under the same counter. big deal.
<Nutssh> 8, so that it fits in the Sys.max_integer (or whatever it is exactly)
<vincenz> Nutssh: 2
<vincenz> actually 4
<vincenz> sorry
<Nutssh> Ok.
<vincenz> 1 bit for it being an int
<vincenz> 1 bit for it being neg/pos
<Nutssh> Yup.
<mrvn_> vincenz: nah, negative ints are fine for addresses.
<vincenz> mrvn_: not when comparing
<mrvn_> sure.
<vincenz> oh really?
<vincenz> so what if I have a block from
<mrvn_> memory ranges from -2G to +2G.
<vincenz> [2*30-2, 2*30+4]
<vincenz> mrvn_: you're not thinking
<mrvn_> vincenz: on reading normalize by "ptr-2G"
<vincenz> hmm
<vincenz> then I only need a factor 2
<vincenz> aka, 1 bit loss
<mrvn_> Even factor 4 would be fine though.
<vincenz> still, too much hassle
<Nutssh> It will be messy and bug-prone. Divide by the extra factor of 2. IMO Simplicity and correctness is more important than speed. Violate only when the performance gain is worth the costs.
* vincenz nods
<vincenz> I agree with Nutssh
<vincenz> anyways I have used the external caml_int32_compare
<vincenz> (and someone should really fix the .mls in ocaml)
<mrvn_> vincenz: is it faster?
<vincenz> I believe so
<vincenz> and not just a little apparently
<kinners> you can also use Int64.float_of_bits, and have an inlined float comparison
<vincenz> kinners: but they have the c_code !
<vincenz> they just forgot to change the PErvasives to an external line in the int64 and int32.ml
<Nutssh> Divide by the factor of 4 should be a good win. Lower memory alloc, lower GC, less active space so the cache will have higher hitrate. Less indirection. Pass in registers. Inlining.
<vincenz> Nutssh: either way, I need to find way to have inlining accross functors
<vincenz> and does ocaml inline accross .mls?
<vincenz> cause look at this
* Nutssh sped up a program by 30% with two changes. Change to using an array instead of a list. (which reduced memory usage by ~60%), and using a copy&pasted Array.sort that applies to float arrays only.
<Nutssh> vincenz: It does, but inlining is usually not a bottleneck. It doesn't do code duplications with functors. (AFAIK), but a defunctorizer can remove functors from a program turning it into a straightline module which will inline.
<vincenz> Nutssh: euhm
<vincenz> let size b e = Size.of_int32 (Int32.sub e b)
<vincenz> where Size.of_int32 is just
<vincenz> the identity
<vincenz> I'm considering putting size and address into one ml
<vincenz> so they share their type t
<Nutssh> Can you divide by a factor of 4?
<vincenz> Nutssh: no
<vincenz> for my system (linux), however, memory never goes above 0x18
<vincenz> so I could use an int
<vincenz> but I don't awnt to risk it
<vincenz> but going back to address.ml and size.ml
<vincenz> is there inlining do you think?
<vincenz> nm, I'll look at the .s
<Nutssh> I would do it, thats probably got the highest payoff for the least cost, and would be easy and quick to test.
* vincenz nods
<vincenz> Nope, it inlines :)
<vincenz> hmm
<Nutssh> oprofile is non-invasive. If you have a lot of functions, *that* is something you need.
<vincenz> Nutssh: I know, just don't feel like compiling my kernel
<vincenz> never done it so I don't know what options I need
<vincenz> I might hae figured out a way to bypass the functor system
<mrvn_> vincenz: apt-get install kernel-image-2.6.9-*
<vincenz> so I can get further inlining
<Nutssh> vincenz: If the maximum you can get is 20% -- say, try using ints --- is it worth spending this much time, and making it this much more complicated?
<vincenz> Nutssh: no
<vincenz> though I do notice that with the externals I get a lot of speedup
<vincenz> an dthat's not messy at all
<vincenz> I just have in address and size.ml
<Nutssh> *nods*
<vincenz> external compare : t -> t -> int = "caml_int32_compare"
<kinners> you can write a faster compare32 function in ocaml, but not for int64 afaik
<kinners> (only slightly faster)
<vincenz> kinners: how so?
<vincenz> I sincerely doubt that, caml_int32_compare just gets the values into 2 re gisters and does a cmp
<kinners> vincenz: just a let cmp32 (x:int32) (y:int32) = if x<y .. etc.
<vincenz> kinners: < is polymorphic
<vincenz> and I think it uses compare inside
<kinners> vincenz: it just avoids the function call, but with int64, the compiler doesn't bother handling them specially so it passes it off to a more generic compare
<vincenz> kinners: no
<vincenz> < is from Pervasives
<mrvn_> You can probably do some Obj.magic stuff and do a compare that gets inlined.
<vincenz> and if you look in the .c
<vincenz> it uses the polymorphic compare
<vincenz> tho ..
<mrvn_> But if that is faster than a loop over the two words of data?
<vincenz> you're right
<vincenz> too bad it's two cmps
<mrvn_> vincenz: build a module with address*size as type.t and do a compare over the 4 words in one go.
<Nutssh> vincenz, how long will this program run on a typical invocation?
<vincenz> Nutssh: 20-30 minutes
<Nutssh> Minutes of CPU? Hours of CPU? Days of CPU?
<vincenz> 5225.70user 51.38system 1
<Nutssh> So, if this is successful, you'll save ~3-5 minutes of CPU time. How much time have you spent trying to do this optimization?
<vincenz> no idea
<vincenz> I use this often tho
<vincenz> 1 hour?
<vincenz> 2 hours?
<vincenz> with some other stuff I di
<vincenz> d
<Nutssh> I'd use the program as-is, IMHO.
<vincenz> Nutssh: well if you consider that I have to use this for a lot of stuff
<vincenz> saves me time
<Nutssh> The 'good enough' rule. :) My last program was spending about 25% of its time in Random, but I didn't see any way to speed it up going to C without another few hours of work.. I only expected it to run for 20-40 hours total. Not worth a day of my time to save 5-10 hours of CPU.
<vincenz> Nutssh: I expect to use this a lot
<vincenz> and not only me, others as well
* vincenz is going to make a small test where he uses int's
<Nutssh> How much is a lot? If you succeed, you might save 10%. Thats almost 1000 invocations if you value your time 20x more valuable than CPU time.
GreyLensman has quit ["Leaving"]
<vincenz> Nutssh: make that 5x
<vincenz> not 20x
<Nutssh> Ok.. I gotta get for about 2 hours. Tell me how much using ints saves, would ya?
<vincenz> I'll try ints after this
<Nutssh> Ok.. I'll read it when I get back.
<vincenz> Ok, small question
<vincenz> file x.ml
<vincenz> type t = int
<vincenz> module Sub = struct
<vincenz> type t= ...
<vincenz> how do I access the global t?
<Smerdyakov> I would guess that you can't.
<Smerdyakov> Save it to another name beforehand.
<vincenz> ok, thnx
kinners has quit [Read error: 238 (Connection timed out)]
<vincenz> ls
ramen has joined #ocaml
vezenchio has quit ["None of you understand. I'm not locked up in here with you. YOU are locked up in here with ME!"]
<vincenz> ls
<vincenz> hmm, seems my biggest bottleneck now is alloc
<Nutssh> What did you change?
<vincenz> flattened some mixins into one (though I doubt that changed a lot)
<vincenz> remove the compare_val usage
<vincenz> and actually tried int instead of Int64
<vincenz> though I'm going back to Int64 after
<vincenz> what I'm thinking...
<vincenz> everytime I read a packet
<vincenz> I'm creating new vals
<vincenz> aka, allocating
<vincenz> wouldn't it be better if I read them into a ref and passed the contents?
<vincenz> that way I wouldn't be reallocating each time
<Nutssh> Thats call-by-reference semantics not call-by-value.. I don't know.
<vincenz> just
<vincenz> somewheere in .ml
<vincenz> let read_b = ref 0
<vincenz> then in the read is
<vincenz> read int read_b
<vincenz> and !read_b
<vincenz> though I wonder if ocaml does COW
<Nutssh> No, it doesn't. refs have reference semantics, not value semantics.
<vincenz> I know
<vincenz> but
<vincenz> let a = ref 0;;
<vincenz> let b = !a;;
<vincenz> incr a;;
<vincenz> a -> 1
<vincenz> b -> 0
<vincenz> so when does it allocate new place?
<Nutssh> Once, with the 0, then a reference to the 0, then the 0 is copied into b (and the assignment to b is invalid)
<vincenz> assignment?
<Nutssh> I thought you meant b <-0 when you wrote b -> 0
<vincenz> nono
<vincenz> just result
<Nutssh> Huh?
<vincenz> just the results of the computation
<Nutssh> Can you write a syntatically correct program to explain what you want to explain?
<vincenz> don't worry, it's a non-issue
<vincenz> I wish that the gc could be customised
<vincenz> which reminds
<vincenz> ..me
<vincenz> there are major issues with ocaml
<vincenz> with the GC system
<Nutssh> I've not had a problem with it.
<Nutssh> What are you noticing?
<vincenz> well problems are imaginable
<vincenz> basically lets say you have c++ (or c) interfacing with ocaml
<vincenz> with c++ being the calling-code
<vincenz> (aka main program is in c++, not ocaml)
<vincenz> ok
<vincenz> ?
<Nutssh> ok.
<vincenz> well when you have values that you want to store
<vincenz> you have to rootify them
<vincenz> however
<vincenz> let's say you call an ocaml function from c++
<vincenz> with callback2(functionptr, param1, param2) for instance
<vincenz> the return value is alive
<vincenz> but you have to rootify it if you don't want it to be gc'd
<vincenz> now...between the period that you get the return-value and the time that you rootify, it's imaginable that the GC kills it
<Nutssh> No. Ocaml is not multithreading. GC can only run at certain times, eg, during allocations. As long as you don't do anything else with ocaml after getting the return value, no rootification is needed.
<vincenz> euhm.... the gc is a separate thread afaik
<vincenz> that I noticed
<vincenz> cause at first I didn't know about rootify
<vincenz> I had c++ call ocaml
<vincenz> store the value, but not rootifiy it
<Nutssh> No, hasn't in a couple of years. Its a stop&gc algorithm.
<vincenz> and suddenly later the variable was gone
<Nutssh> Yes.
<vincenz> even though I hadn't accessed other ocaml code
<Nutssh> If you want it to persist across *any* ocaml operation that might cause a GC, it must be made a root.
<Nutssh> It was running only C++, not a single ocaml function in the ocaml runtime was called?
<vincenz> I think so, though I'm not sre
<vincenz> maybe I'm wrong
<Nutssh> AFAIK, there's only a small list of ocaml runtime functions you can safetly call without the potential of a GC.
* vincenz nods
<vincenz> well if Multithreading was ever done you could see how that'd be a problem
<vincenz> that's looking more like it
<vincenz> top 4 lines in gprof
<vincenz> 11.33 624.47 624.47 456220571 0.00 0.00 camlMap__add_120
<vincenz> 10.03 1177.41 552.94 2002546647 0.00 0.00 camlMap__bal_93
<vincenz> 9.63 1708.56 531.15 1259587358 0.00 0.00 caml_int_compare
<vincenz> 8.95 2201.83 493.27 530639386 0.00 0.00 camlMap__find_130
<Nutssh> Multithreading would be a serious rethink of the runtime, for that reason and myriad locking issues. Assume it will be quite a while.
* vincenz nods
<Nutssh> Um.. Is there a reason you're not using a hash table?
<vincenz> not really
<vincenz> except that it's non-functionaly
<vincenz> why is hash better?
<Nutssh> That would probably cut the Map overhead by 4x-5x, and cut compare time out.
<vincenz> not sure
<vincenz> for most tables I only have in the order of 10-30 elemnts
<vincenz> and for the most intensive one I can't use hashtables
<vincenz> there is one table with in the order of 18k elements
<vincenz> and it's accessed during each logpacket
<vincenz> (90M logpackets)
<vincenz> but I can't make a hashtable out of it
<vincenz> :(
<Nutssh> It can be a win even with a small table. Ocaml is good because you can focus on the high level. Unless you want the functionality of maps, hashtables are usually better.
<vincenz> euhm, what functionality of map does hashtable not have?
<vincenz> nm, sortedness
<vincenz> well there's one table that I know is my botleneck
<Nutssh> Yes you can, Two layer hash table, one based on, say, first 16 bits, second on second 16 bits.
<vincenz> let me show you
grirgz_ has joined #ocaml
<vincenz> well I won't show you code
<vincenz> but the most used map has the comparison function:
<vincenz> let compare (b0, e0) (b1, e1) =
<vincenz> if e0 <= b1 then -1
<vincenz> else if e1 <= b0 then 1
<vincenz> else 1
<vincenz> e0 is always > b0
<vincenz> and e1 > b1
<vincenz> (that last else should be 0)
<vincenz> basically it's for blocks
<vincenz> non-overlapping blocks sort to either -1 or 1, and if they overlap at all it's 0
<Nutssh> Batch the data up and Array.sort. There are high level design choices that could be worth a lot more.
<vincenz> batch the data?
<Nutssh> Drop everything into an array and sort the array.
<vincenz> euhm
<vincenz> can't do that
Blicero has joined #ocaml
<vincenz> it changes as I see MALLOCpackets or FREEpackets
<vincenz> besides, how does that get me a gain?
<vincenz> I'd still have to do bisect-searching on the array
<Nutssh> Compare might have been 15% of the tuntime before, but map is worth 40%.. I'd try to figure out how to replace/optimize your use of map, not microoptimize compare_int
<vincenz> no I know
<vincenz> but I know that that odd map is the most used map
<Nutssh> If Map is the biggest overhead. Did switching away from OO make it more than 30% faster?
<vincenz> not quite sure to be honest
<vincenz> I still have the oo code
<vincenz> either way
<vincenz> there's one mixin
<Nutssh> Focus on the profile. Shaving 20% off of 50% of the runtime wins compared to 50% off of 15%.
<vincenz> that uses my trie
<vincenz> which if I add it in doubles my runtime
grirgz has quit [Read error: 110 (Connection timed out)]
clog has joined #ocaml
mattam has quit [Read error: 110 (Connection timed out)]
mlh has joined #ocaml
pango has quit ["Client exiting"]
kinners has quit ["leaving"]
Herrchen has joined #ocaml
pango has joined #ocaml
pango has quit [Remote closed the connection]
velco has joined #ocaml
velco has quit [Read error: 104 (Connection reset by peer)]
mayhem has joined #ocaml
<mayhem> 'lo
mrsolo_ has joined #ocaml
mrsolo has quit [Read error: 113 (No route to host)]
mattam has joined #ocaml
pango has joined #ocaml
Submarine has joined #ocaml
<Submarine> has somebody run experiments with respect to optimal minor heap sizes on various processors?
<mellum> Not me. Would be interesting, though.
<mellum> Is there a compiler option for it?
<Submarine> run-time options
<Submarine> see the Gc module and the ocamlrun documentations
<mellum> Hm. At least on Alpha, it's compiled in IIRC
<Submarine> sorry?
<mellum> Oh, you're talking about the byte code interpreter... I never use that
<Submarine> No.
<Submarine> If you read the documentation for ocamlopt, you will see that ocamlopt-compiled programs take almost the same parameters in environment variables.
Submarine has quit ["ChatZilla 0.9.61 [Mozilla rv:1.7.3/20040913]"]
Tristram has quit ["leaving"]
ianxek has joined #ocaml
pango has quit ["Leaving"]
budjet has joined #ocaml
pango has joined #ocaml
<vincenz> Stupid question
<vincenz> how do you left align with Printf?
<vincenz> nm
mrvn has joined #ocaml
budjet has quit [Read error: 110 (Connection timed out)]
mrvn_ has quit [Read error: 110 (Connection timed out)]
srv_ has joined #ocaml
srv has quit [Read error: 232 (Connection reset by peer)]
Blicero_ has joined #ocaml
Blicero has quit [Read error: 104 (Connection reset by peer)]
mayhem has left #ocaml []
mlh has quit [Client Quit]
skylan has quit [Client Quit]
skylan has joined #ocaml
<vincenz> Which gui-lib is most used with ocaml?
mrsolo_ has quit [Read error: 110 (Connection timed out)]
vezenchio has joined #ocaml
<Demitar> vincenz, probably lablgtk(2).
<vincenz> trying to get wxocaml to compile to no avail :/
<vincenz> Demitar: 1 or 2?
* vincenz takes 2
ramen has quit ["[BX] Did somebody say BitchX?"]
<Demitar> vincenz, lablgtk2 is what you want for new applications.
<vincenz> kewl
<vincenz> configured/compiled/installed without a glitch
<vincenz> tried an example from a tut without a glitch
<vincenz> too bad I had to install ev erything manually (mandrake still works with 3.07)
<Demitar> manually <> godi?
<vincenz> godi?!?
<vincenz> anice
CosmicRay has joined #ocaml
Kevin_ has joined #ocaml
Kevin_ has quit [Remote closed the connection]
<vincenz> is there an xml module for ocaml?
<vincenz> nm, pxp
mrvn is now known as unignored
unignored is now known as mrvn
<vincenz> IS is possible to make your own widgets with lablgtk2?
<Demitar> Perhaps... :) Usually you really don't need to though.
<vincenz> well if one wanted to make a diagram editor
<vincenz> aka shapes you can click on and drag, copy, paste
<vincenz> you need a widget to represent a shape, no?
<Demitar> Then you want to use the gnome-canvas.
<vincenz> part of lablgtk?
<Demitar> It has an interface, yes.
<vincenz> do you know the name?
<vincenz> got it
<vincenz> Oh yeah, who ye all rooting for?
<vincenz> B or K?
Blicero_ has quit [Read error: 104 (Connection reset by peer)]
<vincenz> hmm
pango has quit [Read error: 110 (Connection timed out)]
pango has joined #ocaml
<vincenz> Fatal error: exception Gtk.Error("GtkMain.init: initialization failed
<vincenz> ml_gtk_init: initialization failed")
<Demitar> What did you do?
<vincenz> just a basic example
<vincenz> I installed libglade.devel and other libs
<vincenz> but now I removed them again
<vincenz> Never mind
<vincenz> my DISPLAY wasn't se
<vincenz> ugh, everytime I opena new screen DISPLAY defaults to localhost:10.0
<mrvn> That would be what DISPLAY was set before you started screen in your ssh session.
<vincenz> 0ok it works now
<vincenz> hmm
* vincenz will be right back
vincenz has quit ["leaving"]
vincenz has joined #ocaml
<vincenz> Back
<vincenz> :)
<vincenz> anyone have experience with GnoCanvas?
<Demitar> There are som examples. Go look at them. And IIRC there is a tutorial even.
<vincenz> not for gnoCanvas
<vincenz> nm
<vincenz> Woot !
<vincenz> I can show a circle
* vincenz beams
Herrchen has quit ["bye"]
monochrom has joined #ocaml
<vincenz> Woot!
<vincenz> I can move objects :)
<Demitar> It's a remarkable piece of technology. :)
<vincenz> I mean ocaml and gtk
<vincenz> ..with..
* vincenz goes to the next thing, popupmenus
sweetcpl has joined #ocaml
sweetcpl has quit []
Loopus has left #ocaml []
gcharlo2 has joined #ocaml
gcharlo2 has left #ocaml []
<async> is it uncommon to have two ml files which call functions from the other? (kind of like mutually inclusive files?)
<TheDracle> .. They're both separate modules, I don't think that's uncommon.
<async> i have a main.ml and a parser.ml, the main.ml uses the parser functions, and the parser.ml uses the main functions
<async> ok
<TheDracle> It's probably simpler from a design point of view to have a hierarchical structure.
<TheDracle> But not a requirement.
<TheDracle> Hm.. Or maybe it is.
<TheDracle> Hm, maybe you need to define interfaces first to compile.
<TheDracle> Hm, I may be wrong about that, I can't figure out how to compile two cross-referencing modules together. Even when I compile to objects and then just use the compiler to link it complains about the symbols in the other not being available yet.
Banana has joined #ocaml
<Demitar> async, TheDracle: That's a FAQ, check the mail archives for details.
<TheDracle> And the answer is?
<TheDracle> Heh.
<Demitar> IIRC you can do it but it's slightly tricky. :)
<TheDracle> Ah.
<TheDracle> Hm.. Kind of strange, I'd expect it to combine the symbols before checking them.
monochrom has quit ["hello"]
<vincenz> euhm
<vincenz> you can't have cyclic dependencies
<vincenz> that won't be linkeable
<TheDracle> Demitar claims that you can, you have to do some tricks though.
<TheDracle> Why exactly isn't it linkable?
<TheDracle> Hm, it's kind of irritating to have to place all of your objects and source files in the order that they're used.
<Demitar> The nasty trick is to cat *.ml > foo.ml; ocamlc foo.ml
<TheDracle> Yeah, it seems like it 'should' be linkable, but it isn't in preference of making the compiler more light weight.
<mrvn> If you have cyclic depends then you need *.mli files.
<vincenz> no
<TheDracle> Yeah, I mentioned above I was thinking along those lines.
<mrvn> If the *.mli files become cyclic then you have to merge that into one file with "let rec foo ... and bar ..." and similar.
<vincenz> the linker won't link
<mrvn> vincenz: Sure it will. compile all *.mli files first and then the *.ml and then link.
<Demitar> mrvn, it won't link.
<mrvn> Demitar: Got an example? I do that all the time.
<Demitar> It will compile but then you have to ocamlc -o foo A.cmo B.cmo but if A depends on B and B depends on A?
<vincenz> mrvn: it will compile but not link
<Demitar> Let me verify my statement. :)
<vincenz> the .cmo's must be in order
<vincenz> I can strongly claim that
<mrvn> Demitar: a.cmx depends on b.cmi, b.cmx on a.cmi.
<vincenz> mrvn: not for linking!!!
<vincenz> the .cmx or .cmo must be in the right order to link
<vincenz> hence, no cyclic dependencies
<mrvn> mrvn@frosties:~/t% ocamlopt -o foo a.cmx b.cmx
<mrvn> No implementations provided for the following modules:
<mrvn> B referenced from a.cmx
<mrvn> That kind of error?
<vincenz> yes
<mrvn> mrvn@frosties:~/t% cat a.ml
<mrvn> let a () = B.b ()
<mrvn> Hmm. Somehow you could get that to work I think.
<Demitar> mrvn, by an extra layer of indirection but that would pretty much defeat the purpose.
<mrvn> Like 'let a (b_fn) = b_fn ()'?
<mrvn> and a main.ml that binds A and B together?
<mrvn> mrvn@frosties:~/t% ocamlopt -o foo.cmxa -a a.ml b.ml
<mrvn> mrvn@frosties:~/t% ocamlopt -o foo foo.cmxa
<mrvn> Thats how you can link it. Make a lib and then link it to a binary.
async_ has joined #ocaml
async has quit [Read error: 110 (Connection timed out)]
<vincenz> you lose inlining
<TheDracle> Hm... I think the question was "is using cyclic dependencies common," and I think since it's such a difficult thing to do, the answer in this case is "no."
<vincenz> yup
palomer has joined #ocaml
<vincenz> cyclic dependencies are a sign of bad design
<palomer> say I have a module that implements several signatures?
<palomer> s/say/can
<vincenz> palomer: you can look at it from different signatures, yes
<palomer> if I have a parametric module that takes an ORDERED and another which takes a ARITHMETICABLE, can I make a structure for which I can pass to both?
<vincenz> yes
<vincenz> just make sure that the module defines all the methods required by the signatures
<palomer> wow that rocks
<palomer> ocaml is so much better than sml
<vincenz> and if you have an .mli for it
<vincenz> make sure the .mli exports all the funcs that both ORDERED an dAR... need
* palomer hugs ocaml
<palomer> gcaml looks cool
<vincenz> gcaml?
<palomer> generic ocaml
<palomer> it's wayyy cool
<vincenz> odd but good recipes: bacon, goatcheese, balsamic vinegar and springonions
<vincenz> palomer: what's it do?
<palomer> I was wondering, are polymorphic variants really useful?
docelic has quit [Read error: 113 (No route to host)]
gim has joined #ocaml
<Demitar> palomer, in theory, perhaps not. In practice they are wonderful.
<palomer> give me an example
<Demitar> You can pass it to a function without prepending ThatOldModule. a zillion times. :)
<vincenz> what are polymorphic variants?
<vincenz> I'm not familiar with CS-lingo
<TheDracle> Maybe polymorphic return types?
<vincenz> ?
<vincenz> like returnin a class?
<TheDracle> Like type bob = Int of int | Float of float | List of int list;;
<vincenz> so what's special about that?
<TheDracle> And let joe val = match val with something -> Int 5 | somethingelse -> Float 6;;
<TheDracle> Ahem, 6.0
<TheDracle> That you can write functions that take polymorphic arguments, and return polymorphic types.
<TheDracle> Like, in C, if you write a function it can take either a defined type, say int bob(float joe);
<TheDracle> Where it 'has' to return only an int, and take only a float.
<palomer> polymorphic variants is an ocaml thing
<palomer> I've yet to see it in another language
<TheDracle> Is this something different?
<vincenz> TheDracle isn't that standard in ocaml?
<vincenz> euhm
<vincenz> it's not so hard
<vincenz> palomer: define a struct with a union and enum inside
<vincenz> inc
<vincenz> in .. c
<TheDracle> Right, in C you can do the same thing, just not in a type safe manner.
<TheDracle> I mean, just use a void* and you can return anything.
docelic has joined #ocaml
<TheDracle> And it definitely doesn't tell you if you haven't conidered all possible arguments.
<vincenz> TheDracle: euhm if you pass a struct with an enum and union inside it's typesafe as lnog as you make sure to use the right union-variable depending on the enum
<TheDracle> Right. Or when you set it up you make sure to specify the correct value.
<TheDracle> It's not really type safe in that instance, since you have to consider its type inside the code itself.
<TheDracle> Ocaml provides a language mechanism for doing this.
<TheDracle> Type safety is the compiler's job, not the programmers ;)
Anvil_Vapre has joined #ocaml
<palomer> union in C is a way to save space
<palomer> nothing more
kinners has joined #ocaml
<mrvn> palomer: a union in C is a way to store one of multiple types in a variable with the possibility of the implementation saving space.
<mrvn> It doesn't have to though.
<mrvn> vincenz: Have you read http://caml.inria.fr/ocaml/htmlman/manual003.html about variants?
<vincenz> basically sumtypes
<mrvn> #type 'a btree = Empty | Node of 'a * 'a btree * 'a btree;;
<mrvn> type 'a btree = Empty | Node of 'a * 'a btree * 'a btree
<mrvn> That is a polymorphic tree.
gim_ has joined #ocaml
gim has quit [Connection timed out]
async_ has quit [Read error: 110 (Connection timed out)]
CosmicRay has quit ["Client exiting"]
Kevin_ has joined #ocaml
Kevin_ has quit [Client Quit]
mlh has joined #ocaml
gim_ has quit ["bye"]
<TheDracle> Is btree a binary tree? #type 'a btree = Empty | Node of 'a btree * 'a * 'a btree;;
<TheDracle> A union can be used for polymorphic types as well, palomer, it isn't simply used to save space.
<TheDracle> Wow.. Polymorphic Variants are weird.
<palomer> TheDracle, give me an example
<palomer> anytime you use a union you can simple omit the the keyword union and the result will be the same
avatar8888 has joined #ocaml
avatar8888 has left #ocaml []
allemann454 has joined #ocaml
allemann454 has left #ocaml []
srv_ has quit [Read error: 238 (Connection timed out)]