gildor changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | OCaml 3.12.0 http://bit.ly/aNZBUp
clog has joined #ocaml
nannto_ has quit [Read error: Connection reset by peer]
nannto_ has joined #ocaml
jamii has joined #ocaml
<jamii> so I have a program that get stuck in an infinite loop somewhere. whats the best way to find out what function it is stuck in?
<jamii> I kind of thought that the debugger could do that but it looks like it will only stop at checkpoints
<jamii> maybe if I just keep calling step with big arguments
<thelema> jamii: can't you get a backtrace?
<thelema> even if it segfaults, use gdb to examine the stack
* thelema just did this earlier today
<jamii> thelema: yeah, I discovered I can call run and pause it with ctrl-c to get the backtrace
<jamii> thelema: i wasn't sure before that how to get to the right point in the program
<jamii> thelema: thanks though
<jamii> mmm, now I have an exception that is only thrown in the bytecode version. so I can't debug the original problem
lamawithonel_ has quit [Ping timeout: 240 seconds]
joewilliams is now known as joewilliams_away
hto has quit [Quit: Lost terminal]
hto has joined #ocaml
alexyk has joined #ocaml
alexyk has quit [Quit: alexyk]
dnolen has quit [Quit: dnolen]
jamii has quit [Ping timeout: 258 seconds]
vivanov has joined #ocaml
mfp has quit [Ping timeout: 255 seconds]
mfp has joined #ocaml
philtor has quit [Ping timeout: 276 seconds]
Yoric has joined #ocaml
Cyanure has joined #ocaml
f[x] has joined #ocaml
edwin has joined #ocaml
Cyanure has quit [Remote host closed the connection]
ygrek has joined #ocaml
Yoric has quit [Quit: Leaving.]
ftrvxmtrx has joined #ocaml
edwin has quit [Remote host closed the connection]
edwin has joined #ocaml
vivanov has quit [Quit: Lost terminal]
ikaros has joined #ocaml
vivanov has joined #ocaml
ygrek has quit [Ping timeout: 250 seconds]
mfp has quit [Read error: Connection reset by peer]
ftrvxmtrx has quit [Quit: Leaving]
ftrvxmtrx has joined #ocaml
mfp has joined #ocaml
sepp2k has joined #ocaml
avsm has joined #ocaml
Cyanure has joined #ocaml
avsm has quit [Ping timeout: 255 seconds]
vivanov has quit [Quit: Lost terminal]
avsm has joined #ocaml
deavidsedice has quit [Quit: http://quassel-irc.org - Chat comfortably. Anywhere.]
deavid has joined #ocaml
sepp2k has quit [Ping timeout: 255 seconds]
lopex has joined #ocaml
chambart has quit [Ping timeout: 246 seconds]
chambart has joined #ocaml
ikaros has quit [Quit: Ex-Chat]
sepp2k has joined #ocaml
Cyanure has quit [Remote host closed the connection]
ygrek has joined #ocaml
vivanov has joined #ocaml
Tommytom429 has joined #ocaml
<Tommytom429> Hello, I need some help about threafs in Ocaml.
<Tommytom429> threads*
<rproust> Tommytom429: any specific question? or do you need a generic tutorial?
<Tommytom429> Just a answer
<rproust> ask away
<Tommytom429> When I create a thread with Tread.Create, the thread is executed ?
iris1 has joined #ocaml
<rproust> afaik yes
<rproust> `Thread.Create f ()` creates and starts the threads
<Tommytom429> But when I do an infinite loop in my thread, it is not execute
<rproust> can you cpoy/paste code somewhere
<Tommytom429> of course wait a minute, I rewrite it correctly
edwin has quit [Remote host closed the connection]
<f[x]> infinite loops that do not allocate may usurpate the scheduler
<Tommytom429> Doesn't work with not an infinite loop
edwin has joined #ocaml
<sgnb> f[x]: what do you mean by "usurpate"?
<sgnb> I just tried with a trivial loop (let rec f () = f () in f) and it successfully use one of my cores...
<f[x]> I mean ocaml scheduler
<f[x]> if you create two such threads - only one will ever run
<Tommytom429> And result "Coucou\nHello\n"
<sgnb> f[x]: I mean I cannot find a definition for "usurpate"
<f[x]> sgnb, maybe wrong word, I meant that no (ocaml) thread switches will occur
<f[x]> s/usurpate/usurp/
<f[x]> :)
<Tommytom429> but without threads this code work
<f[x]> Tommytom429, your program exits before the second thread finishes its work
<sgnb> Tommytom429: isn't there anything to keep the process alive?
<Tommytom429> OOh
<Tommytom429> Ok, when the main exit, the thread too ?
<f[x]> yes
<Tommytom429> Ok, you save me
<Tommytom429> Thank you very much
<Tommytom429> it's the opposite of csharp
<sgnb> ocaml threads are just posix threads IIRC
<Tommytom429> Mmh I think .NET doesn't know posix...
ygrek has quit [Ping timeout: 250 seconds]
<iris1> Dear experts, I have a simple question about ocaml. (I tried to google the answer for it but have unfortunately not succeeded.) When you pass an array argument to a function in ocaml, does it get passed by value or by reference? Thank you!
<sgnb> iris1: by reference
<sgnb> everything (but int, char, bool... everything fitting in a word) is passed by reference in ocaml
<zorun> yeah, but some are mutable while others are not
<f[x]> more simple rule - all mutable values are passed by reference
<zorun> so a list is passed by reference, but the function can't modify it
hcarty has quit [Remote host closed the connection]
<iris1> Thank you!
dnolen has joined #ocaml
<Tommytom429> So
<Tommytom429> My code work now, but there is a little problem
<Tommytom429> The string "Coucou" is printed when the thread is stopped, it's normal ?
<flux> tommytom429, you should flush standard output. with printf it can be done with sequence %!
<flux> so "Coucou\n%!"
<Tommytom429> printf ?
<flux> oh, right
<flux> you used print_string
<Tommytom429> Like in C ?
<flux> then you want to use flush stdout
<flux> yes, there is Printf.printf in ocaml
<Tommytom429> I didn't know
<Tommytom429> Thx you
<Tommytom429> With Printf.printf "%s" "Coucou\n";
<Tommytom429> Same result
<flux> Printf.printf "%s%!" "Coucou\n";
lamawithonel has joined #ocaml
<Tommytom429> It work!
<Tommytom429> %! mean stdout ?
<adrien> %! means flush
<Tommytom429> okok, i will search flush term
<zorun> as stated, you can also use "flush stdout"
<zorun> as a separate instruction
lopex has quit [Ping timeout: 252 seconds]
<Tommytom429> I must flush just one time at the beginning ?
<zorun> actually, when writing to a terminal, there is a buffer
<zorun> so it isn't written immediately
Cyanure has joined #ocaml
<Tommytom429> Okay, thx, i understand
<zorun> with flush, you force the buffer to be displayed on the terminal
<Tommytom429> There is flush in C ?
<Tommytom429> manual flush
<zorun> think so
<zorun> in C++, std::endl adds a new line and flushes
<Tommytom429> noted
<Tommytom429> Thx you very much
lopex has joined #ocaml
boscop__ has joined #ocaml
boscop_ has quit [Ping timeout: 250 seconds]
<iris1> I noticed that sometimes people use the $ as an infix operator denoting function composition. It does not seem to be part of ocaml but I think you can define it as "let ($) f g x = f (g x)". My question is: Is there a standard place $ (and perhaps similar other things) are defined? If not, is there a list of such conventional idioms? I am not worried about the effort required to implement such stuff, but would like my code to look idiomati
<iris1> Thank you!
<flux> iris1, I think $ is not that great an option for ocaml, because its precedence isn't the same as in, say, haskell
<flux> also $ is used in camlp4/5 source, so that's a difficulty as well
<flux> thelema can introduce you to the function composition operators provided by Batteries :)
<f[x]> what has haskell to do with ocaml syntax?
<f[x]> there are many things different - that's not an argument
<f[x]> $ will cause problems with camlp4 only inside quotations iiuc
* f[x] likes ($)
<flux> well, what other languages use $ for function composition than haskell?
<Tommytom429> thx for all by
Tommytom429 has left #ocaml []
f[x] has quit [Ping timeout: 244 seconds]
boscop__ is now known as boscop
f[x] has joined #ocaml
ftrvxmtrx has quit [Quit: This computer has gone to sleep]
<thelema> iris1: I find that because ocaml is eager, ($) puts things in reverse order, and that the pipeline operator `let (|>) x f = f x` is more useful
<iris1> Thank you very much! I'll try it out.
<thelema> Array.enum dfa.qs |> map (get_map |- Optimizers.raz_dec |- Vect.length) |> Enum.reduce (+)
<thelema> (|-) is the point-free version of (|>)
Snark_ has joined #ocaml
<zsparks> thelema: what do you mean, the point-free version?
<zsparks> what's its type?
<thelema> # let ( |- ) f g x = g (f x);;
<thelema> val ( |- ) : ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c = <fun>
<zsparks> oh, okay, so it's function composition
<thelema> yes.
thomasga1 has joined #ocaml
dnolen has quit [Quit: dnolen]
<thelema> (f |- g) == (fun a -> f a |> g)
<thelema> the right side is pointed, as there's an explicit `a`, while the left is called point-free
<zsparks> right, that was my guess
<zsparks> I'd just never heard function composition referred to as the points-free version of anything before
<orbitz> point-free, or tacit programming, just refers to the lack of explicit variable names
<orbitz> Haskell does use ($) for function compositon btw, it uses (.)
avsm has quit [Quit: Leaving.]
<orbitz> doesn't use i mean*
thomasga1 has quit [Ping timeout: 276 seconds]
<zsparks> orbitz: yeah, and sml uses o
iris1 has quit [Quit: iris1]
thomasga1 has joined #ocaml
lopex has quit []
philtor has joined #ocaml
barismetin has joined #ocaml
barismetin has quit [Remote host closed the connection]
barismetin has joined #ocaml
Snark_ is now known as Snark
vince|work has joined #ocaml
<vince|work> Can anyone explain this syntax error? I copied it verbatim from Jason Hickey's book.pdf: http://ideone.com/cQD53
joewilliams_away is now known as joewilliams
<thelema> ah, "add x l" is incorrect
<thelema> it should just be `val add : 'a -> 'a t -> 'a t`
<thelema> similarly for mem
Reaganomicon has joined #ocaml
<vince|work> thelema: ah, thank you
<vince|work> thelema: also, is there a reason why using currying in the struct doesn't work? I tried to write let add = (::) and that didn't work, however let add x l = x::l did.
<thelema> (::) is a constructor, not a function.
<thelema> it has special handling in the lexer so it doesn't have to follow the normal conventions for variant constructors
<thelema> lexer and parser
<vince|work> thank you
<thelema> vince|work: you're welcome
ftrvxmtrx has joined #ocaml
EM03 has joined #ocaml
<EM03> I need readline in my ocaml REPL , common package for this?
<thelema> EM03: rlwrap
<EM03> thanks thelema
<orbitz> rlwrap works great
ftrvxmtrx has quit [Quit: This computer has gone to sleep]
SoftTimur has joined #ocaml
<SoftTimur> Hello, I have defined a 2-dimensional array by "Array.make_matrix". Is there a function to check if a pair (x,y) is its valid argument ?
<thelema> i.e. to check whether x,y is within that array?
<SoftTimur> thelema: yes
<thelema> 0 <= x && x < xmax && 0 <= y && y < ymax
<thelema> nothing built in, and nothing in batteries AFAIK
<SoftTimur> ok... then how could I get "xmax" from that array?
<thelema> Array.length mat.(0)
<thelema> or maybe that'
<thelema> s ymax
<thelema> `Array.length mat` is one dimension, `Array.length mat.(0)` is the second
thomasga1 has quit [Quit: Leaving.]
<SoftTimur> so to get xmax, I would need "Array.length (Array.length mat)"?
<thelema> no
<thelema> Array.length mat gives you the length of the first dimension.
<SoftTimur> I see...
<thelema> Array.length mat.(0) gives you the length of the second dimension (i.e. the length of the array in position 0 in the first axis)
<thelema> matrix = array of arrays
BiDOrD has quit [Ping timeout: 240 seconds]
<SoftTimur> I see... thank you thelema
<thelema> n/p
BiDOrD has joined #ocaml
thomasga1 has joined #ocaml
thomasga1 has quit [Ping timeout: 276 seconds]
enthymeme has joined #ocaml
ymasory has joined #ocaml
alexyk has joined #ocaml
olauzon has joined #ocaml
olauzon has quit [Client Quit]
Cyanure has quit [Remote host closed the connection]
vince|work has quit [Ping timeout: 252 seconds]
likebike has quit [Ping timeout: 252 seconds]
ymasory has quit [Quit: Leaving]
ftrvxmtrx has joined #ocaml
ikaros has joined #ocaml
ygrek has joined #ocaml
ulfdoz has joined #ocaml
ymasory has joined #ocaml
sepp2k has quit [Ping timeout: 255 seconds]
sepp2k has joined #ocaml
mcclurmc_home has joined #ocaml
lopex has joined #ocaml
ymasory has quit [Quit: Leaving]
itegebo has quit [Ping timeout: 276 seconds]
jamii has joined #ocaml
Anarchos has joined #ocaml
<Anarchos> why does the implementation of Unix.lockf is primarily based on fcntl and secondary on lockf ?
<thelema> Anarchos: my best guess is that this worked better on someone's box than just basing it on lockf
<jamii> whats the best way to profile the ocaml heap? valgrid/massif doesnt seem to be able to read symbol names in 3.11
<thelema> jamii: to determine what's using the most memory? There's supposedly a way to do this with ocamlviz, but I've not been able to figure that part of it out.
ymasory has joined #ocaml
<jamii> thelema: yeah, something is leaking hugely . I'll take a look at ocamlviz but I couldn't get it working at all last time
<Anarchos> jamii did you try ocamlprof ?
<thelema> Anarchos: ocamlprof doesn't do memory profiling, does it?
<jamii> I'm pretty sure it just does execution/branch counts
<thelema> jamii: that's what I thought.
<jamii> I don't see anything else in the doc page
<thelema> jamii: I have used valgrind/massif on my ocaml code, and it has helped me as there's some different paths for objects to get allocated, and massif distinguished between them.
<thelema> but if it's not helping you, try to get ocamlviz's memory profiling up.
<thelema> oh yeah, the repo name is wrong on the ocamlviz download page.
<jamii> thelema: I think almost all my allocation is in Rope.create and Rope.append. I just need to know which function is causing allocations
<thelema> sylvain changed it with an upgrade, but they've not maintained their website much.
<thelema> jamii: really? you're having memory leaks with Rope? You know it's functional, and if you keep the old roots, all old data will be kept
<jamii> thelema: not leaks so much. somewhere along the line something just blows up and eats all my memory. I probably have some inefficient function being called with huge arguments but I don't know where it is
<thelema> ah, that's totally different.
<jamii> yeah, maybe leak is not an accurate choice of word
<thelema> what Rope.create are you calling?
<jamii> of_latin1, slice, append
<thelema> pastebin code?
<jamii> its one of the old icfp contest tasks
<jamii> getting some practice in before this years
<thelema> since you're not using unicode, you can save some CPU by using Rope.of_string
harrison has joined #ocaml
<thelema> then camomile won't be involved there.
<jamii> ok
<jamii> do you know if there is a way to write UChar.t literals for pattern matching? It doesn't seem to export any constructors
<thelema> not so much. Uchar.t is internally just int.
SoftTimur has quit [Remote host closed the connection]
<thelema> It might not be too hard to add support for them in estring, but I know very little about it.
ftrvxmtrx has quit [Quit: Leaving]
<thelema> exploding a string with 1E6 entries will take lots of memory - 2*word_size * 1E6
<thelema> and for a little while, you'll have two copies of that around.
<jamii> I guess I need a better way to do this pattern matching
malouin has joined #ocaml
<jamii> I'm going to run it into the debugger till it starts to explode and the see what function its in
<jamii> *and then
<rproust> isn't there a lazy explosion available
<rproust> smthng evaluating to a lazy list rather than a list
<thelema> rproust: well, Rope.enum gives you a lazy enum, which is convertible to a lazylist
<thelema> nothing quite directly
<rproust> as long as it doesn't alocate 2*word_size * 1E6…
<thelema> yeah, but thinking about that, that's only 2*8B*1M*2 = 32MB, which isn't so much.
<thelema> I sometimes have my minor heap set bigger than that.
<jamii> rproust: good point, Rope.enum might work better
<thelema> match Rope.enum r |> LazyList.of_enum with [^'A'; 'B'] -> ...
<thelema> oops, [% 'A'; 'B'] ->
<thelema> err again, | 'A' %:: 'B' %:: _ ->
vivanov has quit [Ping timeout: 263 seconds]
jamii has quit [Ping timeout: 258 seconds]
<malouin> Can someone help me understand... in http://hpaste.org/47807 , how is '_a option array not a type of 'a dtable = 'a option array ?
<thelema> malouin: for module interfaces, '_a is distinct from 'a
<zorun> thelema: are these syntaxes all valid? :) never seen something similar
<thelema> 'a means any type
<thelema> zorun: no, only the last one. I thought pa_llist provided lazy list literals, but it doesn't.
<malouin> thelema: so what does '_a mean?
<thelema> malouin: '_a means that it can be used with any type, but once it's used with a type, it's stuck on that type
<malouin> I see.
<thelema> mutable types need this distinction, as otherwise you could get around type safety by putting in an int into a 'a option array and take out a float
jamii has joined #ocaml
<thelema> malouin: what you probably want is for empty to be a function taking ()
<thelema> let empty () = Array.make 5 None
<thelema> And then your add function doesn't have to clone the array each time, but can just mutate the existing table, unless you really want to keep copying arrays
<malouin> Yeah, this module is a hack.
<malouin> I do want to keep copying them, because they're lookup tables for nodes within a trie.
<malouin> and the trie is a pure functional datastructure so I thought, why ruin it by destructively modifying the arrays.
<thelema> why use a trie over other trees if you're not going to mutate it?
ygrek has quit [Ping timeout: 250 seconds]
<malouin> thelema: I wanted to do fast union operations.
<malouin> I don't really mind mutating it, but for now I thought it would be easier to think about if it were purely functional.
<thelema> ok. Fast unions are reasonable over other map trees. Batteries has this.
<malouin> is the copy causing type problems?
<thelema> no, just an inefficiency.
<thelema> the copy is fine.
<malouin> yeah I agree that it's ugly ;)
nimred has quit [Ping timeout: 255 seconds]
nimred has joined #ocaml
<thelema> you just need a dtable generator instead of a dtable constant.
ygrek has joined #ocaml
<malouin> the () fixes the type problem?
<malouin> OOOOh I get it.
<malouin> ah, that's great. I completely understand the problem now.
<thelema> :)
ccasin has joined #ocaml
Snark has quit [Quit: Ex-Chat]
bzzbzz has quit [Quit: leaving]
hcarty has joined #ocaml
bzzbzz has joined #ocaml
sepp2k has quit [Quit: Leaving.]
sepp2k has joined #ocaml
harrison has left #ocaml []
alexyk has quit [Read error: Operation timed out]
alexyk has joined #ocaml
edwin has quit [Remote host closed the connection]
jamii has quit [Ping timeout: 258 seconds]
lamawithonel has quit [Remote host closed the connection]
gildor has quit [Read error: Operation timed out]
gildor has joined #ocaml
<thelema> hi gildor
ygrek has quit [Ping timeout: 250 seconds]
Anarchos has quit [Quit: good night to all, happy hacking]
<sheets> If I get this: "Fatal error: exception Assert_failure("typing/parmatch.ml", 1680, 22)" while compiling, what should I do?
<sheets> This should not occur under normal circumstances, correct? Is it a compiler bug? Should I go and rebuild ocaml 3.12.0 so that instead of asserting, I get a real exception?
jamii has joined #ocaml
<thelema> sheets: yes, you have triggered a bug
<thelema> parmatch sounds like parameter matching for named and optional parameters
<sheets> hmm… haven't been changing those recently
<thelema> or not, it's for dissection of partial matching
<thelema> (* Detection of partial matches and unused match cases. *)
<sheets> yes, that makes more sense
<thelema> (* Exported unused clause check *)
<sheets> I guess I should try to get some sort of location information out of the exception if this assert comes back
<thelema> apparently an exception was raised when trying to... I'm not sure.
<thelema> you'd have to strip some lines of code out of the source to turn the assertion back into an exception.
<sheets> yes… for now I'm avoiding it all together :-P
<sheets> debugging this issue that is. it seems to have gone away with further editing though not on anything related to partial pattern matches
<thelema> well, maybe you have some complex pattern matches that it's trying to prove are complete and sometimes it fails hard
<thelema> anyway, gotta go, back later
<sheets> kk thanks for the info
itegebo has joined #ocaml
oriba has joined #ocaml
sepp2k has quit [Quit: Leaving.]
ymasory has quit [Quit: Leaving]
ymasory has joined #ocaml
lamawithonel has joined #ocaml
ymasory has quit [Read error: Connection reset by peer]
lamawithonel has quit [Remote host closed the connection]
lamawithonel has joined #ocaml
mcclurmc_home has quit [Ping timeout: 255 seconds]
barismetin has quit [Remote host closed the connection]
avsm has joined #ocaml
avsm has quit [Quit: Leaving.]
ikaros has quit [Quit: Ex-Chat]
dnolen has joined #ocaml
Morphous has quit [Ping timeout: 255 seconds]
jamii has quit [Ping timeout: 258 seconds]
Associat0r has joined #ocaml
Morphous has joined #ocaml
alexyk has quit [Quit: alexyk]
boscop_ has joined #ocaml
boscop has quit [Read error: Connection reset by peer]