gildor changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | OCaml 3.12.1 http://bit.ly/nNVIVH
<oriba> I'm looking for code that extracts me a all cycles from a set of directed graphs. any idea, where there is code that does this for me?
<thelema> oriba: maybe not exactly that, but ocamlgraph should give you a good start
ulfdoz has quit [Ping timeout: 240 seconds]
ulfdoz has joined #ocaml
jessicah has joined #ocaml
<oriba> thelema, thy, but ocamlgraph I have seen... it has no loop detection
<oriba> s/thy/thx/
<thelema> oriba: loop detection is easy, enumerating cycles is not so trivial.
* thelema tries to remember back to graph theory
<thelema> DFS can give you many loops, but there's a trick necessary to pull out the last few that DFS doesn't find easily
<oriba> what I want to do...
<oriba> I have a In/Out mapping
<oriba> a -> b
<oriba> I have a set of them
<oriba> like a integrated circuit with in/out
<oriba> I want to map the input alphabet to the output alphabet
<oriba> so then Ihave a transiton Inpiut-Output table)
<oriba> and now I want to detect all cycles of that mapping
<oriba> I throw in the data, let the machine operate on it, get the output fo a given input
<oriba> all possible inputs mapped to all outputs give me a complete transition/mapping table
<oriba> and now I want to look for all cycles in this
<oriba> DFS means depth first search?
<oriba> thelema,
<oriba> then i need to use a tree?
sebz has quit [Quit: Computer has gone to sleep.]
<thelema> back now.
<oriba> thelema, is there a reason why you recommend ocamlgraphe, even there is no loop detection? Do you think building on it makes things easier for me?
<oriba> I could use a tuple for IN/OUT mapping otherwise
<thelema> yes, ocamlgraph will efficiently handle all the graph operations
<oriba> and it would be possible to make a DFS on top of it?
<oriba> DFS means depth first search? (trees?)
<thelema> yes, DFS is depth first search
<thelema> it generates a spanning tree, but also marks other edges in a useful way
<oriba> aha, nice :)
<oriba> can you recommend the whole book, or was this only a hint to read it online?
<thelema> it sounds like you have a directed graph, though.
<oriba> yes
<thelema> It's just what I found via google
<oriba> ok
<thelema> I think this algorithm is undirected
<hcarty> thelema: I have four rounding funcions... I'm not sure that many are needed, but some set selected from those should be a start.
<thelema> for directed... it should be easire
<oriba> I have a simple loop detection build for me via Set or Map module
<thelema> hcarty: round_to_int, round ?(precision = 1.0), ...?
<oriba> but it stops after first cycle
<oriba> and does not look at all directed garphs
<oriba> maybe I should apply my stuff just on any opossible input
<hcarty> thelema: round ?(decimal = 1)
<oriba> but it then would mean I have inefficient search I guess
<thelema> oriba: don't search all possible inputs.
<hcarty> thelema: And round/round + precision as separate functions
<thelema> what are you going to do when you find a cycle? DFS will give you that efficiently
<thelema> what are you going to do with the cycles?
<thelema> hcarty: an optional precision parameter merges the round/round+precision, what's the fourth?
<oriba> I want to know which cycles are there, and which values are in the cycles
<thelema> hcarty: two ways of specifying the precision?
<oriba> then I want to look at the structure of the values
<hcarty> thelema: Yes
<oriba> there are pattern in the values.
<oriba> it's from a CA-like stuff on pattern recognition
<thelema> hcarty: well, let's add two: round_to_int and round with an optional precision parameter
<thelema> CA = Counting Automaton?
<hcarty> thelema: Precision specified which way? 0.1 is easier to see initial, ~-1 avoids the 0.3333 issue.
<oriba> thelema, btw... at the moment I create for each input the in/out mapping and let graphviz draw it. And look for the cycles in the graphics ;)
<hcarty> initially that is
<thelema> oriba: are all the cycles going to be disjoint?
<oriba> thelema, CA: Cellular Automaton
<thelema> oriba: ok.
<oriba> but it's a certain stuff
<oriba> not true CA
<thelema> hcarty: let's do precision specified in decimal.
<oriba> it is a comparison on equality of the neighbour fields
<oriba> something like edge detection
<oriba> but the person who has constructed it, says, it uses dialectical traids and can be related t thinking ;)
<oriba> I just want to look at it and throw off the esoteric and philosophiccal sidenotes from it
<oriba> for me it's just an automaton
<thelema> oriba: a 90% solution is to run DFS and and back-edges complete cycles.
<oriba> he sees there Yin/Yang and such stuff
<hcarty> thelema: Should I leave the code for the other functions in the .ml, or ditch them?
<oriba> thelema, will it also find many indeopendent cycles?
<thelema> hcarty: If you like, you can put them in comments, in case someone later really wants them.
<oriba> I have in some of these machines more than one cluster of cycling graphs
<thelema> oriba: by running DFS from a starting point, you'll get most of the cycles in that starting point's component.
<oriba> hmhh
<thelema> oriba: you'll have to run DFS from other components to find cycles in them
<oriba> the clusters are not connected
<thelema> this is not normally a problem, why is it a problem for you?
<oriba> I may start with a complete set and throw out the found values from the rest
<oriba> and start with the rest again
<oriba> what?
<oriba> what is not a normal problem?
<thelema> doing another DFS for the next component
<oriba> ?
<thelema> yes, just remove each vertex from your set as you encounter it.
<oriba> I mean I may need to start the dfs until no start-values were left over in the bucket of already visited stuff?
<oriba> aha
<oriba> yes
<hcarty> thelema: Is it acceptable to have the default rounding function match an optional parameter?
<oriba> thelema, thanks for the hints and ideas. Maybe I use ocmlgraph, maybe I do it on my own with my Set/Maps stuff. I need to go to bed soon. thanks again.
<thelema> hcarty: match an optional parameter?
<thelema> oriba: you're welcome.
<oriba> bye
<thelema> hcarty: it's okay for the default rounding function to have an optional parameter
oriba has quit [Quit: oriba]
<hcarty> ?(precision = 1.0) requires an implicit match precision with ...
<thelema> ? That's done automatically by ocaml, no?
<hcarty> It is, I was thinking of runtime overhead in the case of huge numbers of rounding operations
<hcarty> I don't know if such a thing happens in the real world
<thelema> if someone needs an uber-high performance rounding function, they should probably use assembly and operate on the bit-representation of floats
<thelema> well, maybe that's an exaggeration. Yes, there'll be a bit of overhead from the optional argument. But I bet if they're doing a lot of rounds with the same precision, that match can be done once.
<thelema> I'd bet that ocamlc optimizes the partial application of an optional parameter
<thelema> so the match isn't done each call.
<hcarty> If not, the function could be changed later to return the resulting rounding function in the case of a partial application.
<hcarty> Or perhaps that is done by the compiler
<hcarty> already
<thelema> yes, I'd bet it's already done by the compiler.
<thelema> I can use Bench to test mu hypothesis
<hcarty> thelema: Is there a reference on adding tests to Batteries?
<thelema> I wrote a bit in the wiki there.
<thelema> ok, my testing shows that optional arguments are optimal for partial application
<hcarty> thelema: Excellent
astory has left #ocaml []
<hcarty> thelema: That doesn't compare the option of a no-precision-choice version
<thelema> ok, I'll add that.
<thelema> I expect that to be a bit faster
<hcarty> thelema: I'm not too concerned, I'd just like to put whatever is going to be the most useful and future-proof
<hcarty> into the module
<thelema> hmm, that's odd - I'm getting different results... maybe it's because Random is giving different ... nah, it should seed the same...
<hcarty> Those seem like some surprisingly large differences
<thelema> it's a pretty huge stdev on "opt"
<thelema> and then on "hand"
<thelema> it looks like the middle result has a more reasonable stdev
<hcarty> thelema: I sent a pull request for ( |? ), verify_arg, Float.(is_special, round, round_to_int)
<thelema> although I'm surprised I didn't get warnings on outliers
<hcarty> I can make modifications if there are any concerns with those functions
<thelema> FP_subnormal is reduced precision?
<hcarty> That sounds correct
<gnuvince> Aren't sets testable for equality with the = operator?
<hcarty> thelema: Very close to 0.0
<_habnabit> gnuvince, what's wrong with Set.equal ?
<thelema> hcarty: fwiw, I'd do the (10 ** float precision') once in round_dec
<smango> are module signatures something you have to write yourself or is there a way to generate them from your code?
<hcarty> thelema: Ah, very true
<gnuvince> _habnabit: just makes my job a little harder for a small program ;)
<_habnabit> smango, neither. signatures are inferred if you don't have a .mli file
<thelema> gnuvince: sets aren't testable for equality with = because two sets may represent the same collection of elements but different tree structures because of insertion order
<gnuvince> thelema: thanks
<hcarty> smango: You can generate them from a .ml
<hcarty> smango: ocamlc -i foo.ml > foo.mli
<thelema> gnuvince: two equal sets might be (=) equal, but might not. unequal sets will always be (<>)
<hcarty> smango: Or "ocamlbuild foo.inferred.mli" if you are using ocamlbuild
<hcarty> smango: A manually specified signature is not required in most cases, but it is considered best practice by some
<thelema> hcarty: I don't think the logic of your round_dec function is right.
<hcarty> thelema: It may not be - I haven't tested it very thoroughly since we're not including it
<hcarty> If it's wrong then I'd rather pull it from the comments too
<thelema> hcarty: let's pull it.
<hcarty> It worked for the limited testing I did, but it's probably best to not include suspect code in Batteries, comments or no.
<thelema> 10.0 ** (1-1) = 1, but precision = 1 should be 10
<thelema> hcarty: I don't think the precision -> precision' conversion is correct
<hcarty> thelema: It's supposed to specify the decimal precision
<hcarty> 1 = precision one place to the left of .
<hcarty> -1 = precision one place to the right of .
<thelema> oh. I'm misinterpreting the parameter
<hcarty> 2 = precision one place to the left... and so on
<thelema> n/m, it's correct, but needs more documentation to explain what the parameter means
<hcarty> If we're not including it it's probably best to drop the code anyway
<thelema> hcarty: agreed
arubin has quit [Quit: arubin]
<hcarty> thelema: Resubmitted
<thelema> hcarty: merged
<hcarty> thelema: Very cool. I'm off - have a good night
<thelema> you too.
rgrinberg has quit [Read error: Connection reset by peer]
Kakadu has joined #ocaml
sebz has joined #ocaml
Drakken has joined #ocaml
sebz has quit [Quit: Computer has gone to sleep.]
dnolen has quit [Quit: dnolen]
dnolen has joined #ocaml
dnolen has quit [Client Quit]
Kakadu has quit [Ping timeout: 260 seconds]
ulfdoz has quit [Ping timeout: 260 seconds]
Kakadu has joined #ocaml
rgrinberg has joined #ocaml
reynir has joined #ocaml
Kakadu has quit [Quit: Konversation terminated!]
reynir has quit [Ping timeout: 248 seconds]
mcclurmc has quit [Excess Flood]
mcclurmc has joined #ocaml
destrius has quit [Quit: Leaving.]
ikaros has joined #ocaml
ankit9 has quit [Quit: Leaving]
musically_ut has joined #ocaml
mcclurmc has quit [Excess Flood]
mcclurmc has joined #ocaml
edwin has joined #ocaml
maufred has joined #ocaml
Cyanure has joined #ocaml
ankit9 has joined #ocaml
ikaros has quit [Quit: Ex-Chat]
ttamttam has joined #ocaml
ttamttam has quit [Read error: Connection reset by peer]
ttamttam has joined #ocaml
ttamttam has quit [Read error: Connection reset by peer]
ttamttam has joined #ocaml
probst has joined #ocaml
Boscop has quit [Ping timeout: 248 seconds]
morolin has quit [Ping timeout: 244 seconds]
struktured has quit [Remote host closed the connection]
JdpB42 has quit [Ping timeout: 260 seconds]
JdpB42 has joined #ocaml
avsm has joined #ocaml
JdpB42 has quit [Ping timeout: 258 seconds]
ikaros has joined #ocaml
JdpB42 has joined #ocaml
_andre has joined #ocaml
sebz has joined #ocaml
hnrgrgr_ has joined #ocaml
hnrgrgr_ has quit [Client Quit]
fraggle_ has quit [Remote host closed the connection]
thomasga has joined #ocaml
Drakken has left #ocaml []
fraggle_ has joined #ocaml
raichoo has joined #ocaml
avsm has quit [Quit: Leaving.]
avsm has joined #ocaml
ikaros has quit [Quit: Ex-Chat]
sebz has quit [Quit: Computer has gone to sleep.]
f[x] has quit [Ping timeout: 245 seconds]
f[x] has joined #ocaml
larhat has joined #ocaml
avsm has quit [Quit: Leaving.]
avsm has joined #ocaml
avsm has quit [Read error: Connection reset by peer]
avsm has joined #ocaml
avsm has quit [Read error: Connection reset by peer]
avsm has joined #ocaml
jonafan has quit [Ping timeout: 245 seconds]
ikaros has joined #ocaml
sepp2k has joined #ocaml
jonafan has joined #ocaml
peddie has quit [Ping timeout: 240 seconds]
liteblackk has joined #ocaml
peddie has joined #ocaml
milosn has joined #ocaml
sebz has joined #ocaml
liteblackk has quit [Quit: Ухожу я от вас]
xmichaelx has joined #ocaml
<xmichaelx> could someone explain me why this code doesn't work: let minimum list = List.fold_left (min) List.hd(list) list i', trying to find minimum value of the list using fold_left
<xmichaelx> i know that there are ready functions for it, it's only for educational purposes :)
<adrien> let minimum list = List.fold_left min (List.hd list) list
<adrien> not checked but it's most probably because your parens are wrong
<xmichaelx> works, thank you :)
<smango> xmichaelx: for added fun, write a function using fold_left which finds the second lowest number of the list
<adrien> xmichaelx: the function won't work on an empty list however ;-) (and the error won't be very clear)
<adrien> but you have some time before really having to take care about that
<xmichaelx> yeah, hd function complains because it's called on empty list :)
<smango> I was always told you should avoid hd and just pattern match
<adrien> you can quite simply do the check first and raise an exception explaining the issue with better words
<smango> let minimum list = match list with head::tail -> List.fold_left (min) head tail | [] -> failwith "List empty"
<adrien> remove the parens around min however ;-)
<smango> >.>
<adrien> ;-)
<smango> i'm used to using either (fun acc x -> ...) or (+), (*) etc
<adrien> =)
sebz has quit [Quit: Computer has gone to sleep.]
sepp2k has quit [Remote host closed the connection]
sebz has joined #ocaml
ikaros has quit [Ping timeout: 248 seconds]
oriba has joined #ocaml
testcocoon has quit [Quit: Coyote finally caught me]
testcocoon has joined #ocaml
testcocoon has quit [Client Quit]
testcocoon has joined #ocaml
xmichaelx has quit [Ping timeout: 258 seconds]
sebz has quit [Quit: Computer has gone to sleep.]
ikaros has joined #ocaml
sebz has joined #ocaml
gnuvince has quit [Quit: ""]
avsm has quit [Quit: Leaving.]
ankit9 has quit [Quit: Leaving]
beckerb has joined #ocaml
struktured has joined #ocaml
beckerb has quit [Ping timeout: 240 seconds]
beckerb has joined #ocaml
bzzbzz has quit [Quit: leaving]
pcjoby has joined #ocaml
ankit9 has joined #ocaml
everyonemines has joined #ocaml
sebz has quit [Quit: Computer has gone to sleep.]
sebz has joined #ocaml
nixfreak_ has joined #ocaml
<nixfreak_> any resources / links for creating web apps using ocaml ?
<gildor> nixfreak_: ocsigen.org
<nixfreak_> thx
<hcarty> nixfreak_: And http://projects.camlcity.org/projects/ocamlnet.html for lower-level options
Asmadeus has quit [Ping timeout: 240 seconds]
Asmadeus has joined #ocaml
metasyntax|work has joined #ocaml
avsm has joined #ocaml
xmichaelx has joined #ocaml
nixfreak_ has quit [Quit: Page closed]
avsm has quit [Quit: Leaving.]
avsm has joined #ocaml
SoftTimur has joined #ocaml
<SoftTimur> hello
<thelema> hello
Cyanure has quit [Remote host closed the connection]
raichoo has quit [Quit: leaving]
SoftTimur has left #ocaml []
Drakken has joined #ocaml
<gildor> thelema: BTW, I think there are indeed an hardware pb on ocamlcore.org
<gildor> thelema: I have opened a bug at OVH so that they can have a look at that
<thelema> gildor: okay then. Do you have a minute for me to bounce an idea off you?
<thelema> gildor: n/m, I'll keep thinking about my idea.
<thelema> gildor: as to ocamlcore, will it be transitioned to INRIA's servers?
beckerb has quit [Remote host closed the connection]
<Drakken> good morning
<thelema> Drakken: hi
<Drakken> Hi thelema. I may take a while to write that graph we talked about, if you haven't given up on me already. I've been sidetracked with other projects related to getting my ocaml system set up.
sebz has quit [Quit: Computer has gone to sleep.]
<gildor> thelema: I am at work (on work time) ping me tonight around 22:00 PM, I should be at home (do it by email if I don't answer your ping on IRC)
<thelema> Drakken: no worries. The graph thing might be a little difficult.
<gildor> 22PM CEST
<gildor> so it is +4,5 hours from now
sebz has joined #ocaml
<thelema> gildor: I'll be busy then, but will try to communicate with you sometime. Don't get fired. :)
<gildor> gildor: concerning transfer to INRIA server, I don't know, but I am under the feeling that caml.inria.fr has been less reliable than ocamlcore.org one's (i.e. more downtime)
<gildor> thelema: ^^^
<gildor> thelema: but it can be a false impression
<Drakken> thelema the graph is trivial. I'm just finding other things to work on as I read manuals and get software installed, and I think those other things are at least as important.
<thelema> gildor: fair enough.
<samposm> if I want to return an array of doubles from C, would (a) float_array = caml_alloc(...) and then filling the array one-by-one using Store_double_field get kinda slow, or would it be better to (b) allocate a Bigarray in ocaml and then give C a pointer so C could fill it in more directly?
<gildor> thelema: an restarting a server at OVH is something like one click and complaining 2 clicks + email
<gildor> thelema: I think you need to contact an admin at INRIA and he is probably only on call at night and probably not on "restarting OCaml server"
<thelema> Drakken: fair enough, working on odb is the most important thing that I wish I could be doing. If you want an important thing to do, work on it.
<thelema> gildor: aside from failing hardware, that's a good comparison.
<hcarty> samposm: I think that it is possible to use an OCaml float array directly in C
<gildor> Drakken: you were the one asking for build deps with OASIS ?
<Drakken> gildor I'm not sure...
<thelema> samposm: ocaml float arrays and strings are C compatible
<thelema> gildor: I think that was someone else, everyonemines
<samposm> hcarty: this webpage tells how to directly read ocaml float array in C, but not how to directly fill it http://www.mombu.com/programming/ruby/t-ocaml-bigarray-and-memory-mapping-2708344.html
<thelema> gildor: he's got some ideas on enhancing ODB to install from local repositories
<everyonemines> me?
<thelema> everyonemines: am I wrong?
<hcarty> samposm: As long as the filling is local, you can pass (double)ocaml_array as a double* in C
<everyonemines> I was asking what a win64 binary of ocaml should have.
<everyonemines> yesterday
<everyonemines> iirc you need bigarray for c compatibility of int arrays ?
<thelema> everyonemines: ok, maybe I'm misremembering.
<samposm> hcarty: allright, that should make it easy. I just was not able to find that piece in info in web :-/
<thelema> everyonemines: yes, for int arrays, you need bigarray. but for float arrays, the representation is the same
<hcarty> samposm: Yes, it's not heavily advertised
<samposm> hehe
milosn has quit [Ping timeout: 258 seconds]
<samposm> I like that phrase!
<thelema> samposm: it could be more clearly spelled out - it's implied from an understanding of the representation.
<everyonemines> On a different topic, I was curious if there's work on ML -> LLVM
<hcarty> samposm: For a more detailed explanation of how that works
<thelema> everyonemines: not too much. There's HLVM
<everyonemines> is that a separate IR, as in ML -> HLVM -> LLVM ?
<Drakken> So..... to install a package with findlib, you have to download and build the package manually, then somehow know what and where all the object and interface files are and feed them to (ocamlfind install) explicitly?
<thelema> everyonemines: it's a different language. just HLVM -> LLVM
<thelema> Drakken: yes.
<thelema> often, wildcards make this not as difficult as it seems
<hcarty> samposm: Sorry, I wrote the cast incorrectly - it's (double *)ocaml_array
<samposm> of course
<hcarty> samposm: Lines 525 - 591 in this link, with the actual C function call on line 569 : http://plplot.svn.sourceforge.net/viewvc/plplot/trunk/bindings/ocaml/plplot_impl.c?revision=12032&view=markup
<hcarty> That's a relatively complex example
<gildor> thelema: it was superbobry
<thelema> gildor: thanks for figuring that out
<Drakken> thelema Okay, that's a start. So do I [make all] but not [make install]? Which files do I need, and where are they?
<thelema> Drakken: for what package?
<thelema> often makefiles will use ocamlfind for install in their install target, or they'll have an install-findlib target to do a findlib install
<Drakken> So do I have to run ocamlfind myself, or do I just need to have findlib installed and run [make install]?
<thelema> the where depends on the package itself
<thelema> if [make install] has the right findlib comand, then that will suffice
<thelema> if not (like lablgtk2), then you'll have to write the correct command
<thelema> usually packages that don't support ocamlfind have source code in src/
<thelema> so [ocamlfind install packagename META src/*.{mli,cmi,cma,cmx,cmxa,cmxs}]
<Drakken> and pray that I didn't miss anything?
<thelema> oh yeah, c objects for stubs...
<Drakken> oops.... :)
<thelema> if you miss something, just [ocamlfind remove packagename] and re-install
<thelema> and *.a
* thelema tries to think of what else he's missing
<f[x]> *.lib *.dll *.so
everyonemines has quit [Quit: Leaving.]
<Drakken> I think I prefer the one where the package authors write the install command themselves.
oriba has quit [Quit: oriba]
<thelema> Drakken: me too.
<thelema> f[x]: what's .lib?
<f[x]> msvc equivalent for .a
<thelema> ah
ttamttam` has joined #ocaml
ttamttam` has quit [Read error: Connection reset by peer]
ttamttam has quit [Read error: Connection reset by peer]
Drakken has left #ocaml []
ttamttam` has joined #ocaml
Drakken has joined #ocaml
maufred has quit [Quit: leaving]
ttamttam` has quit [Remote host closed the connection]
sepp2k has joined #ocaml
sebz has quit [Quit: Computer has gone to sleep.]
sebz has joined #ocaml
sebz has quit [Client Quit]
edwin has quit [Ping timeout: 240 seconds]
raichoo has joined #ocaml
edwin has joined #ocaml
sebz has joined #ocaml
Boscop has joined #ocaml
ttamttam has joined #ocaml
<samposm> 18:28 < hcarty> samposm: As long as the filling is local, you can pass (double)ocaml_array as a double* in C
<samposm> I wonder, what did hcarty mean by that "filling is local"?
<adrien> hmmm
<adrien> the array will start with a length so you need some kind of offset
<samposm> no, I think then ocaml-stuff is before array[0]
<samposm> then -> the
Anarchos has joined #ocaml
<hcarty> samposm: Sorry - I meant that you could run into GC issues if the filling function causes GC activity
scrappy_doo_ has joined #ocaml
<hcarty> samposm: ocaml_array could be moved
<adrien> but when you get an object of type "value" in C, is the length at the beginning of value or at position -1?
<adrien> I seem to remember seeing [-1] somewhere
<samposm> hcarty: but my filling function is C, sure it is not gonna cause any gc activity?
Drakken has quit [Ping timeout: 260 seconds]
<thelema> samposm: as long as you don't use any caml_* calls, you can't cause GC
<thelema> adrien: yes, the length of the array is in [-1]
<thelema> adrien: although only certain bits
ikaros has quit [Ping timeout: 240 seconds]
larhat has quit [Quit: Leaving.]
<hcarty> samposm: thelema is correct - if the filling function is all OCaml-free C you will be safe
<adrien> right, and you can quite easily see that in mlvalues.h
avsm has quit [Quit: Leaving.]
<adrien> I though gcc would spit an ugly warning
ttamttam has quit [Read error: Operation timed out]
Cyanure has joined #ocaml
ulfdoz has joined #ocaml
yezariaely has joined #ocaml
Anarchos has quit [Quit: Vision[0.9.7-H-090423]: i've been blurred!]
Cyanure has quit [Ping timeout: 244 seconds]
ikaros has joined #ocaml
<xmichaelx> what would you recomend for mapping strings onto other objects in ocaml?
<xmichaelx> Hashtbl or sth else?
<thelema> xmichaelx: pre 3.13, Hashtbl
<thelema> hashtbl should be fine for strings because the string hashing function is fine on strings.
<thelema> s/string hashing/generic hashing/
<thelema> an alternative, if you want an immutable structure, is Map.Make(struct type t = string val compare = compare)
<thelema> err, `module StringMap = Map.Make ...`
<_habnabit> what's 3.13 have?
<thelema> _habnabit: a new generic hashing function
<thelema> one that doesn't fail hard on large structures
<_habnabit> ah.
<scrappy_doo_> Why does ocamlfind take the package name as an argument? Shouldn't it be in the META file?
scrappy_doo_ is now known as Drakken
Cyanure has joined #ocaml
<Drakken> I mean [ocamlfind install]
<adrien> it doesn't read the META file during installation
<thelema> Drakken: that's a good question for its author. I guess it's a holdover from before the package name was in the META file, maybe it just makes it easier to do the install
<Drakken> But dependent packages list a specific name in their "requires" section. Doesn't it bork the system if you misspell the package name?
<Drakken> ... while installing
ankit9 has quit [Ping timeout: 252 seconds]
<adrien> installation should be done through some script or makefile so it should be reproductible and not subject to end-user typos
<adrien> so in practice, it doesn't matter
<adrien> much
Boscop has quit [Ping timeout: 252 seconds]
<Drakken> adrien I don't think the LablGTK2 makefile does that.
<adrien> what are you doing with lablgtk2?
<adrien> lablgtk2 doesn't install through ocamlfind
<adrien> it will be fixed soon (tm)
Cyanure has quit [Ping timeout: 276 seconds]
<Drakken> trying to install archimedes for some plotting code.
reynir has joined #ocaml
<Drakken> thelema said something about using findlib to install lablGTK2, and LablGTK2 does have a META file, although there's a comment in README about it not being complete.
thelema has quit [Read error: Operation timed out]
<adrien> mine is better :P
<Drakken> your what?
<adrien> lablgtk2 will already install itself in a subfolder
<adrien> all you need for it to work with findlib is to add the META file in the folder
<samposm> geez, I though I am doing something wrong with the ocaml-C-interface, when getting segfaults. but no, to C code makes them completely on its own :-D
<adrien> heheh :P
<adrien> gdb and Gc.compact and compiling will all possible warnings helps a lot
<Drakken> adrien doesn't ocamlfind put META in site-lib/<package name> automatically?
<samposm> is there an ocaml way to print error messages? or should I just printf on the stdio?
<_habnabit> what kind of error messages?
<_habnabit> you could raise an exception
bzzbzz has joined #ocaml
<adrien> Drakken: depends on ocamlfind's configuration but I think almost only godi does that
<samposm> if certain array operation cannot be done on arrays smaller than N
<_habnabit> okay, so raise an exception
<adrien> Drakken: I have two (three actually) ocaml+findlib nstallations on my computer:
<adrien> Packages will be installed in/removed from: /opt/ocaml/lib/ocaml/site-lib
<adrien> and: Packages will be installed in/removed from: /usr/lib64/ocaml
<adrien> depends on ocamlfind's configuration
dcolish has joined #ocaml
<Drakken> adrien you mean ~/.opt/... ?
<adrien> I have an ocamlfind installation in /opt/ocaml, system-wide, not in my home
<adrien> but I guess I also have one in ~/t/whatever
<Drakken> strike that
<adrien> and by default, it doesn't use site-lib
<Drakken> I was thinking of .odb
<Drakken> What's /opt? I don't have that.
<adrien> you don't have an /opt ? it should at least exist even if empty
<Drakken> nope
<adrien> it's a place to put software that isn't managed by the package manager handling /
yezariaely has quit [Quit: Leaving.]
Cyanure has joined #ocaml
ftrvxmtrx has joined #ocaml
Anarchos has joined #ocaml
ikaros has quit [Quit: Ex-Chat]
avsm has joined #ocaml
_andre has quit [Quit: leaving]
ftrvxmtrx has quit [Quit: Leaving]
ftrvxmtrx has joined #ocaml
thomasga has quit [Quit: Leaving.]
raichoo has quit [Quit: Lost terminal]
oriba has joined #ocaml
ulfdoz has quit [Ping timeout: 244 seconds]
ulfdoz has joined #ocaml
reynir has quit [Ping timeout: 244 seconds]
sebz has quit [Remote host closed the connection]
ikaros has joined #ocaml
sebz has joined #ocaml
sebz has quit [Client Quit]
ulfdoz has quit [Ping timeout: 248 seconds]
Boscop has joined #ocaml
ftrvxmtrx has quit [Read error: Connection reset by peer]
everyonemines has joined #ocaml
milosn has joined #ocaml
ftrvxmtrx has joined #ocaml
Cyanure has quit [Read error: Operation timed out]
ftrvxmtrx has quit [Read error: Connection reset by peer]
edwin has quit [Remote host closed the connection]
<rgrinberg> how come the array module doesn't have functions like combine which are available for lists?
<everyonemines> Same reason it doesn't have an interpolation function. Because it wasn't put in there.
<everyonemines> INRIA people said, the community can implement libraries
<adrien> the stdlib is meant to be small, it's not trying to cover everything
<rgrinberg> ya I'm not complaining just wandering maybe there was a good reason
<everyonemines> But there is batteries.
<everyonemines> wait
<everyonemines> there is one, isn't there?
<everyonemines> Array.append
<everyonemines> oh wait, that's different
<rgrinberg> its ok, let array_zip a1 a2 = a1 |> Array.mapi ( fun i x -> (x,a2.(i)))
<rgrinberg> is good enough
<everyonemines> let combine a1 a2 = Array.(let s = length a1 + length a1 in init s (fun i -> a1.(i), a2.(i)))
<everyonemines> Hmm, I guess your way is nicer.
<Drakken> You need to get the smaller length first.
<everyonemines> Yeah, that too.
<samposm> now this is funny: when I 'ocamlopt -a -linkall lib1.o lib2.ml -o mylib.cmxa' then I can "ocamlopt mylib.cmxa myapp.ml' ...
<samposm> ...then I can removu mylib.cmx, and still succesfully compile 'ocamlopt mylib.cmxa myapp.ml', but the resulting binary runs slower (~2x), than if I don't remove mylib.cmx
<samposm> remove*
<adrien> another reason you don't have an Array.combine: it's not terribly useful and you can do the same without combining
<adrien> samposm: .cmx files are not required but they allow inlining
<samposm> I see
<adrien> try with the .cmx file and with -inline 0
<samposm> yes I had -inline 2 there, too, actually
<everyonemines> I wonder if inline annotations in source would be worthwhile.
<everyonemines> adrien: If you write once and access lots, then I think element pairs of the same type are stored flat and then you get both in a single access ?
<everyonemines> Not that I think the stdlib needs a combine for arrays.
<rgrinberg> sure you can do the same without it, it's just not as convinient. you could ask why have map when we have mapi too by the same logic
<everyonemines> Adding stuff to the stdlib means more stuff everyone looking for a function has to go over.
<everyonemines> It means extra code in everything using the array module.
<everyonemines> Anything you can implement *efficiently* with that little code is questionable.
<everyonemines> let a_zip a = Array.mapi (fun i x -> (a.(i),x)) doesn't justify a stdlib entry.
<everyonemines> My understanding is that there's some room for improvement in compiler inlining algorithms.
<everyonemines> But I guess I'm not familiar with the state of the art.
<everyonemines> Maybe recompilation with profile data, hmm...
<everyonemines> *profiling data
xmichaelx has quit [Quit: Leaving]
everyonemines has quit [Quit: Leaving.]
Morphous has quit [Ping timeout: 248 seconds]
ikaros has quit [Quit: Ex-Chat]
Morphous has joined #ocaml
tlockney_ is now known as tlockney
avsm has quit [Ping timeout: 244 seconds]
<samposm> wtf Sys.max_array_length is under 5 million
Anarchos has quit [Quit: Vision[0.9.7-H-090423]: i've been blurred!]
sepp2k has quit [Remote host closed the connection]
dnolen has joined #ocaml
Boscop has quit [Ping timeout: 244 seconds]
dnolen_ has joined #ocaml
dnolen has quit [Ping timeout: 240 seconds]
dnolen_ is now known as dnolen
peddie has left #ocaml []