gildor changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | OCaml 3.12.0+beta1 http://permalink.gmane.org/gmane.comp.lang.caml.inria/49168
neorab has joined #ocaml
_JFT_ has quit [Quit: _JFT_]
<alexyk> how do I compile with profiling with ocamlfind ocamlopt?
fabjan has quit [Ping timeout: 276 seconds]
ccasin has quit [Quit: Leaving]
brendan has joined #ocaml
brendan has quit [Client Quit]
brendan has joined #ocaml
jakedouglas has quit [Quit: Leaving.]
travisbrady has quit [Quit: travisbrady]
jeddhaberstro has joined #ocaml
Dead_Dreamer has quit []
mjonsson has joined #ocaml
valross has quit [Ping timeout: 258 seconds]
valross has joined #ocaml
<thelema> alexyk: ocamlfind camlopt -p
<alexyk> thelema: right, I gave it to ocamlc too and that didn't work
<alexyk> ocamlopt worked
<thelema> only ocamlopt takes -p
<thelema> run ocamlfind ocamlcp to compile bytecode for profiling
<thelema> (yes, it's silly that it's different for bytecode and native)
pad has quit [Remote host closed the connection]
alexyk has left #ocaml []
jakedouglas has joined #ocaml
alexyk has joined #ocaml
<alexyk> I load Twitter graphs, do Hashtbl.create 1000000, and still gprof shows: 38.14 189.03 189.03 156540322 0.00 0.00 caml_fl_allocate
<alexyk> -- what is it and how do I make it less?
<thelema> float allocate? I'm not cure...
<thelema> freelist allocate...
<alexyk> so it's just allocation. I have a few big hashtables and those I do with H.create 1000000, a million, although they grow to 3 million. Should I just do 3 million at once?
<alexyk> also, I have very many small hashtables in a big one. Each is created with 100, but some may grow much larger -- not many though.
<thelema> it won't hurt to have the hashtable already the right size - it'll have to allocate a bigger hashtable and move everything over anyway.
<thelema> as to little hashtables... I see no problem with that.
<alexyk> thelema: I use H.map; does it allocate the target Hashtbl of the size of the original?
<thelema> yes, it uses Array.map internally
<alexyk> so H.create n is the number of entries or bytes?
<thelema> entries
<thelema> Maybe we could ... drat, the type system won't let us do Hashtbl.map in place
<alexyk> basically ocaml hits the wall -- there's a huge slowdown after a while.
<alexyk> I don't know what does all those allocations
<thelema> well, a bad hashing function can put you in the land of lots of linked list nodes
<thelema> That might cause lots of allocation with map, as it'll allocate the array plus each linked list node
caligula__ has quit [Ping timeout: 240 seconds]
caligula__ has joined #ocaml
patronus has quit [Read error: Connection reset by peer]
EvanR has quit [Quit: leaving]
patronus has joined #ocaml
avsm has joined #ocaml
travisbrady has joined #ocaml
drk-sd has quit [Ping timeout: 260 seconds]
avsm has quit [Read error: Connection reset by peer]
drk-sd has joined #ocaml
avsm has joined #ocaml
avsm has quit [Ping timeout: 260 seconds]
drk-sd has quit [Ping timeout: 260 seconds]
drk-sd has joined #ocaml
ztfw has joined #ocaml
<alexyk> is OCAMLRUNPARAM respected by a native executable?
<thelema> yes
<thelema> at least the 'b' option...
* thelema looks at the list
<alexyk> thelema: so if I say OCAMLRUNPARAM='h=20G', will it allocate 20 GB heap for ,e?
<alexyk> me
<alexyk> looks iike it does, but what does it mean by words on amd64?
<thelema> option l is ignored
<thelema> words are 64-bit values
<thelema> yes, h controls the heap size
valross has quit [Ping timeout: 260 seconds]
<alexyk> ok; so if I do h=5G, I get 40 GB heap. Now will it speed up allocation?
<thelema> no, it'll just change how often the GC does full collections (and how long those take)
waterChip has joined #ocaml
<alexyk> I think that was it, it's faster now, fewer delays; it used to slow down exponentially
<alexyk> but we'll see soon
<alexyk> thelema: did you try mfp's Ternary map? looks very interesting...
<thelema> the size of the minor heap is more important - being able to connect that with how long your temp structures really do last is useful.
<alexyk> thelema: how do I specify that?
<thelema> s=
<alexyk> thelema: and how do you generally set that? :)
<alexyk> I have very large graphs, stats are being built, they are growing, nothing releases
<alexyk> only H.fold may generate garbage while walking the hashtables
<thelema> if you are mapping hashtbls, the old array gets released. It's faster for it to release from the minor heap than from the major
<thelema> I worry that the ternary map doesn't do any rebalancing
<alexyk> thelema: are major and minor heaps separate? i.e. the total will add up?
<thelema> oh, tst is a trie.
<thelema> I think h= gives the total and s= gives the minor, the major is the difference
<thelema> n/m, h is the major
* thelema needed to reread the docs
<thelema> they're effectively separate - values migrate from minor to major
<thelema> the memory sizes add up, yes.
valross has joined #ocaml
ulfdoz has joined #ocaml
Associat0r has quit [Quit: Associat0r]
Yoric_ has joined #ocaml
mjonsson has quit [Ping timeout: 260 seconds]
Yoric_ has quit [Quit: Yoric_]
valross has quit [Ping timeout: 248 seconds]
valross has joined #ocaml
travisbrady has quit [Quit: travisbrady]
alexyk has quit [Quit: alexyk]
jakedouglas has quit [Quit: Leaving.]
jeddhaberstro has quit [Quit: jeddhaberstro]
ttamttam has joined #ocaml
Amorphous has quit [Ping timeout: 248 seconds]
spearalot has joined #ocaml
sgnb has quit [Read error: Operation timed out]
ulfdoz has quit [Ping timeout: 258 seconds]
Amorphous has joined #ocaml
waterChip has quit [Quit: waterChip]
prince has quit [Quit: 전 이만 갑니다.]
myu2 has quit [Remote host closed the connection]
emmanuelux has quit [Remote host closed the connection]
filp has joined #ocaml
ikaros has joined #ocaml
ftrvxmtrx has quit [Quit: Leaving]
aja has joined #ocaml
aja has quit [Read error: Connection reset by peer]
valross has quit [Quit: Ex-Chat]
ftrvxmtrx has joined #ocaml
spearalot has quit [Quit: -arividerchi]
ftrvxmtrx has quit [Remote host closed the connection]
ftrvxmtrx has joined #ocaml
Associat0r has joined #ocaml
StdDoubt has joined #ocaml
<StdDoubt> when using List.fold_left function ac list - the function parameter cannot take more than two arguments?
<flux> basically correct
<flux> however, because ('a -> 'b -> 'a) matches (('a -> 'b) -> 'c -> ('a -> 'b)) which is the same as ('a -> 'b) -> 'b -> 'a -> 'b, this works as well:
<flux> List.fold_left (fun a b c -> a 0) (fun a -> (a + 1)) [] 0
<StdDoubt> thanks
ftrvxmtrx has quit [Remote host closed the connection]
ftrvxmtrx has joined #ocaml
<StdDoubt> how to put a break point in ocamldebug (I always get value unbound)?
oriba has joined #ocaml
<StdDoubt> how to debug programs using the batteries included libraries?
ftrvxmtrx_ has joined #ocaml
ftrvxmtrx has quit [Read error: Connection reset by peer]
<StdDoubt> how to load batteries included in ocaml debug?
<mfp> StdDoubt: it shouldn't be any different from other libs
<mfp> so something like ocamldebug -I /usr/local/lib/ocaml/3.11.2/batteries myprog
<StdDoubt> thanks :)
oriba has quit [Quit: Verlassend]
StdDoubt has quit [Remote host closed the connection]
mlarsson has joined #ocaml
boscop_ has left #ocaml []
boscop has joined #ocaml
derdon has joined #ocaml
_andre has joined #ocaml
rfg has joined #ocaml
Associat0r has quit [Read error: Connection reset by peer]
Associat0r has joined #ocaml
spearalot has joined #ocaml
rfg has left #ocaml []
thrasibule has quit [Ping timeout: 265 seconds]
alexyk has joined #ocaml
fraggle_laptop has quit [Quit: Quitte]
fraggle_laptop has joined #ocaml
avsm has joined #ocaml
mal`` has quit [Quit: Coyote finally caught me]
StdDoubt has joined #ocaml
<StdDoubt> how to remove the last element of a list?
<flux> 1) try to avoid doing it 2) let remove_last l = List.rev (List.tl (List.rev l))
<flux> 3) write a custom function to do that
mal`` has joined #ocaml
ccasin has joined #ocaml
_unK has joined #ocaml
oriba has joined #ocaml
derdon has quit [Remote host closed the connection]
derdon has joined #ocaml
drunK has joined #ocaml
_unK has quit [Ping timeout: 260 seconds]
drunK is now known as _unK
spearalot has quit [Quit: -arividerchi]
<alexyk> what are the Cap submodules in batteries, with [< `Read | `Write > `Read ] ?
<flux> alexyk, it is for emulating c++ const, AFAIK
<alexyk> ah, ok
<StdDoubt> String.nsplit line " " function call blocks and does nothing in the batteriesIncluded am I doing something wrong. line = "Fitness: 12.5"
<flux> stddoubt, hm, it works in my (older version of) batteries
<StdDoubt> in my code it simply does nothing (looks like is in loop)
<flux> hm, batteries has got a lot of changes since the last time I've git pulled..
<flux> (it has switched to ocamlbuild from omake as well)
<StdDoubt> even in the top level stays in a loop with a simple example
<alexyk> does anyone use infix notation for Hashtbl from Batteries?
avsm has quit [Ping timeout: 272 seconds]
<alexyk> I have numeric computations and at some point end up with nan. How can I trace that?
<adrien> easiest is probably to check where NaNs can appear and add debug output
<flux> I would possibly add calls to this function around the code: let trace_nan v = if classify_float v = FP_nan then failwith "Argh" else v
<flux> (possibly even let (!) = trace_nan)
boscop_ has joined #ocaml
<adrien> well, also, NaNs will most probably appear because of a 0. /. 0. (rounding errors? insufficient precision?)
<adrien> infinity /. infinity too, but these are less common
<flux> sqrt (-1.0)
<alexyk> most likely /. 0.
<alexyk> flux: thanks for the tracing idea, neat
boscop has quit [Ping timeout: 265 seconds]
<flux> alexyk, infact if you _really_ want to solve it..
<flux> s/solve/trace/
<flux> you can do:
<flux> let (/.) a b = trace_nan a /. trace_nan b
<flux> same for other suspicious operators
<alexyk> flux: even easier I can make /. check for 0. in demonimator
<alexyk> denominator
<alexyk> demon-animator
<StdDoubt> how to verify if is possible to do a conversion from a string to a float?
ftrvxmtrx_ has quit [Quit: Leaving]
<flux> stddoubt, I would do it this way: let is_float_str s = try float_of_string s; true with _ -> false
<flux> stddoubt, or perhaps a variant of float_of_string that returns an option type would be more suitable
<StdDoubt> thanks :)
boscop_ has quit [Read error: Connection reset by peer]
boscop_ has joined #ocaml
<StdDoubt> what is the best set of libraries to use with ocaml (in order to extend the standard one)?
<StdDoubt> I am having some problems with batteries included (failed with string nsplit and reading a file)
travisbrady has joined #ocaml
<adrien> as of today, probably batteries, so the best thing would be to have your bug(s) fixed in batteries, can you elaborate a bit on them?
* adrien has to leave however
<StdDoubt> ok
<StdDoubt> the first one is concerned with nsplit -> if I execute String.nsplit "XPTO ABC" " ";; or compile it
<thelema> # String.nsplit "foo bar baz" " ";;
<thelema> - : list string = ["foo"; "bar"; "baz"]
<thelema> works for me. what version of batteries?
<StdDoubt> in my case it just blocks (looks like is in a loop)
<thelema> is possible, we fixed a bug in the split code around 1.1
<StdDoubt> let me check one second
<thelema> in the toplevel you can examine [Batteries_config.version]
_unK has quit [Remote host closed the connection]
<StdDoubt> 0.20090331
<thelema> from GODI?
_unK has joined #ocaml
<thelema> you should get a new version. for a while, that was the newest version in GODI, but we're back in sync with GODI and 1.2.2 is available there.
<StdDoubt> is the package the one available in ubuntu 9.10 repositories. I am going to install it
<adrien> sounds pretty unlikely the one in ubuntu is up-to-date/recent
<StdDoubt> it was installed with apt-get install ocaml-batteries-included
<thelema> looks like still an old version is in 9.10
<thelema> Lucid has 1.1.0
<thelema> which should have fixed the bug
oriba has quit [Quit: Verlassend]
<thelema> batteries is pretty easy to install from source, you could try that as well, to get fully up to date.
<flux> fortunately there aren't lots of libraries that depend on batteries, so doing that would not likely mess with the distribution's packaging system. that could change one day, though.
<flux> I suppose libraries might strive to not depend on batteries, though. it's still a big, non-standard dependency.
_unK has quit [Remote host closed the connection]
<StdDoubt> thanks
_unK has joined #ocaml
<thelema> there's an ugly situation where libraries don't depend on each other.
<thelema> and an equally ugly situation where there's too many library dependencies but no automated way to resolve the dependencies (some gnome projects on non-package management systems)
<alexyk> thelema: how do you use infix notation for Hashtbl in batteries?
derdon has quit [Remote host closed the connection]
<thelema> hashtbl <-- (key,value) <-- (key,value) ...
<thelema> of course opening Hashtbl.Infix
derdon has joined #ocaml
<thelema> err, n/m, you can't chain.. hmmm
<thelema> hashtbl <-- (key,value);
<thelema> also [f (hashtbl --> key)]
jakedouglas has joined #ocaml
ccasin has quit [Quit: Leaving]
<thelema> you can only chain <-- with immutable structures
<flux> thelema, I guess if hashtbl <-- (key, value) was chainable, it would lead to superfluous ignores in the most common use case
travisbrady has quit [Quit: travisbrady]
<thelema> maybe putting [ |> ignore ] is a nice way to cap off the chain...
ttamttam has quit [Quit: Leaving.]
alexyk has quit [Quit: alexyk]
alexyk has joined #ocaml
alexyk has quit [Client Quit]
joewilliams_away is now known as joewilliams
boscop__ has joined #ocaml
kmkaplan has quit [Ping timeout: 260 seconds]
boscop_ has quit [Ping timeout: 260 seconds]
travisbrady has joined #ocaml
<thelema> or maybe we can use a postfix operator ;. (or something) to do "|> ignore;"
mlarsson has quit [Ping timeout: 260 seconds]
fraggle_ has quit [Read error: Connection reset by peer]
fraggle_ has joined #ocaml
sgnb has joined #ocaml
<flux> or maybe not just chain <-- :)
<flux> or possibly have an alternate operator for chaining addition
<flux> or do type level trickery and say something like chained h <-- (1, 2) <-- (2, 3) :-)
<flux> (but that would mess up the types quite a bit..)
joewilliams is now known as joewilliams_away
mlasson_ has joined #ocaml
filp has quit [Quit: Bye]
<thelema> well, jquery gains a lot from its chainability
<flux> but it doesn't use it for adding elements?
<flux> for processing lists (searching, narrowing, operating on results, mapping) they do fine
<flux> List.map and List.filter chain already :)
<flux> I do adore how neat jQuery is to use, though
<flux> I wonder if a module as simple would be possible to construct to ocaml (for manipulating xml trees, in a type-safe fashion of course)
itewsh has joined #ocaml
sepp2k has joined #ocaml
<thelema> sounds like a homework assignment for someone
<flux> I guess it'd make sense for that to use the object system
StdDoubt has quit [Quit: Leaving]
alexyk has joined #ocaml
avsm has joined #ocaml
<flux> class ['a] t x = object method map : 'b. ('a -> 'b) -> 'b t = fun f -> new t (f x) end
<flux> Error: This type scheme cannot quantify 'b : it escapes this scope.
<flux> any suggestions?
<flux> (nooo, I didn't try writing a jQuery-like ocaml interface, not me. no.)
mlasson_ has left #ocaml []
emmanuelux has joined #ocaml
ftrvxmtrx has joined #ocaml
ulfdoz has joined #ocaml
th5 has joined #ocaml
sepp2k1 has joined #ocaml
sepp2k has quit [Ping timeout: 272 seconds]
<flux> man, that should be a simple case, but apparently not
myu2 has joined #ocaml
<flux> further simplified: class ['a] t = object method foo : 'b. 'b t = assert false end
<flux> or simply: class type ['a] t = object method foo : 'b. 'b t end
<flux> or even: type 'a t = < foo : 'b. 'b t > (Error: In the definition of t, type t 'a should be t 'b)
<flux> but maybe this kind of object orientation isn't the way to go, after all
<flux> it seems difficult to extend
<flux> ah, I remember seeing that discussion, thank you!
<flux> but unfortunately the workaround destroys the #-chaining :)
<travisbrady> mfp: is your jocaml widefinder solution still available online somewhere? I can't seem to find it.
<mfp> huh let me see
<flux> I wonder what's left of jQuery once you have |> List.map.. I guess nothing, for list manipulation, but for manipulating xml it's different
<flux> I guess the problem boils down to constructing type safe xml tree queries..
<mfp> travisbrady: the VPS being silly again, try http://eigenclass.org:5598/hiki/widefinder2-conclusions
<mfp> travisbrady: the code is under http://eigenclass.org:5598/misc/
avsm has quit [Quit: Leaving.]
<flux> mfp, maybe they should have an ocaml-based vhost-forwarder for enhanced reliability!
<travisbrady> mfp: thank you. Was wf2_multicore2_block.mlthe fastest? On Bray's results page I see "wf-mmap-multicore" as the top JoCaml entry but that's not in /misc
<mfp> oh, those I linked to are wf2
<travisbrady> ahh, ok
<mfp> which didn't use JoCaml
<travisbrady> Is there some way to make just a single operator visible without using open? I want to avoid name collision.
<mfp> Tim Bray's table doesn't include the fastest WF solution I wrote
<flux> travisbrady, let (+^/) = Foo.(^+/) ?
<mfp> IIRC I estimated it'd be under 1s (compared to 1.76s for the one he did time, and 1.5s for wf(32))
<travisbrady> flux: thank you. I feel dumb for having to ask.
<flux> travisbrady, it's part of the learning process :)
<mfp> travisbrady: that'd be wf-mmap-multicore-nore, see http://eigenclass.org:5598/repos/widefinder/head/
<travisbrady> mfp: very cool, thank you.
derdon has quit [Quit: derdon]
th5 has quit [Quit: th5]
alexyk has quit [Quit: alexyk]
jeddhaberstro has joined #ocaml
goncalo has quit [Ping timeout: 265 seconds]
alexyk has joined #ocaml
<alexyk> flux: am using your FP_nan check, but there's no FP_inf. How do I check against infinity?
<flux> alexyk, ..FP_infinite
<flux> it's in the Pervasives documentation
<alexyk> okok
Anarchos has joined #ocaml
slash_ has joined #ocaml
th5 has joined #ocaml
th5_ has joined #ocaml
th5 has quit [Ping timeout: 276 seconds]
th5_ is now known as th5
alexyk_ has joined #ocaml
alexyk has quit [Ping timeout: 265 seconds]
alexyk_ is now known as alexyk
th5 has quit [Ping timeout: 265 seconds]
th5 has joined #ocaml
derdon has joined #ocaml
_andre has quit [Quit: *puff*]
Anarchos has quit [Quit: Vision[0.9.7-H-090423]: i've been blurred!]
avsm has joined #ocaml
jacoblyles has joined #ocaml
<jacoblyles> At the Ocaml console, I can't press the back arrow to edit something that I have typed. Is there a better console than the default one that comes with Ocaml?
<alexyk> jacoblyles: rlwrap ocaml
<jacoblyles> thanks, that looks promising
<alexyk> I'm getting a nan in the following: http://paste.pocoo.org/show/229136/. Even though I check for y == 0., I get: Fatal error: exception Failure("nan in safeDivide => x: 0.000000, y: 0.000000, res: nan"). Is there a way to check for 0. denominator better?
avsm has quit [Quit: Leaving.]
<sgnb> jacoblyles: you can also try "ocamlfind lwt/toplevel.top" after install lwt
itewsh has quit [Quit: There are only 10 kinds of people: those who understand binary and those who don't]
avsm has joined #ocaml
<alexyk> what's lwt?
<alexyk> avsm: hi!
jgrozave has joined #ocaml
<jgrozave> I've got a few camlp4 questions
<jacoblyles> I don't have ocamlfind. Would you recommend using the batteries included ocaml?
<jgrozave> i know that compiling batteries requires ocamlfind
avsm has quit [Ping timeout: 240 seconds]
<jgrozave> i'm assuming any binary install of batteries will depend on ocamlfind (and install it for you if it's a package manager like apt)
<jgrozave> jacoblyles: i know a bit about this having tried to install ocamlfind for quite some time in order to install batteries
ulfdoz has quit [Ping timeout: 260 seconds]
<jacoblyles> I checked macports and batteries is there, so hopefully I will get ocamlfind for free as part of the managed installation
<jgrozave> yeah, batteries relies heavily on it, so you will indeed
<alexyk> how can you explain this:
<alexyk> # let x = 0. in if x == 0. then "zero" else "trouble";;
<alexyk> - : string = "trouble"
<derdon> try = instead of ==
<sgnb> comparing floats with equality looks like a bad idea anyway
<sgnb> (the situation is inverted with e.g. nan)
<alexyk> sgnb: notice I compare with 0. only
<alexyk> I need to prevent division by 0.
<sgnb> yould should compare with epsilon
boscop__ has left #ocaml []
<sgnb> (for the epsilon suitable to your application)
<sgnb> note that division by 0. is "defined" in float
<derdon> sgnb: can you explain why?
<sgnb> derdon: what is your "why" referring to?
<derdon> sgnb: why is division by zero defined within floats?
<sgnb> alexyk: you should divide anyway and check afterwards with classify_float
<sgnb> derdon: it's defined by the IEEE sth standard
<derdon> aha
<sgnb> (which is implemented by most of processors)
<derdon> alexyk: I recommend using try-with
<derdon> alexyk: because I'm a python programmer :P
<sgnb> try-with won't work
<derdon> hm
<alexyk> derdon: no exception is raised
<sgnb> # 1. /. 0. ;;
<sgnb> - : float = infinity
<sgnb> # 0. /. 0. ;;
<sgnb> - : float = nan
<alexyk> wow! who let xacier bot in? oh, sgnb works like one! :)
<sgnb> # 1. /. 1e-1000;;
<sgnb> - : float = infinity
<sgnb> you should definitely perform the division anyway, then check with classify_float
<alexyk> ok
<sgnb> derdon: (for the definedness of /. 0., one of the reasons is hardware optimization IIRC...)
<derdon> sgnb: good to know
<sgnb> basically, the "core" of the processor doesn't have to "wait" for the end of the computation to proceed this way
<jonafan> # #load "unix.cma";;
valross has joined #ocaml
<jonafan> # let f () = Unix.fork (); f ();;
<jonafan> oh sorry
<jonafan> sgnb you're supposed to produce a compiler error there
<jonafan> # let rec f () = Unix.fork (); f ();;
<jonafan> okay now we can proceed
<sgnb> jonafan: are you trying to fork-bomb me?
<jonafan> # f ();;
<sgnb> bad jonafan :-)
<jonafan> hahaha! you're done!
alexyk has quit [Quit: alexyk]
<julm> krkr
alexyk has joined #ocaml
ikaros has quit [Quit: Leave the magic to Houdini]
derdon has quit [Quit: WeeChat 0.3.0]
jacoblyles has quit [Quit: jacoblyles]
jacoblyles has joined #ocaml
jacoblyles has quit [Client Quit]
pad has joined #ocaml
slash_ has quit [Quit: Lost terminal]
sepp2k1 has quit [Quit: Leaving.]
alexyk has quit [Quit: alexyk]
alexyk has joined #ocaml