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
Cyanure has quit [Remote host closed the connection]
dsheets has quit [Quit: Leaving.]
mjonsson has joined #ocaml
fantasticsid has joined #ocaml
dsheets has joined #ocaml
datkin has joined #ocaml
KDr2 has joined #ocaml
Tobu has joined #ocaml
datkin has quit [Remote host closed the connection]
datkin has joined #ocaml
diego_diego has joined #ocaml
ulfdoz_ has joined #ocaml
iago has quit [Quit: Leaving]
ulfdoz has quit [Ping timeout: 244 seconds]
ulfdoz_ is now known as ulfdoz
milosn_ has joined #ocaml
milosn has quit [Ping timeout: 245 seconds]
avsm has quit [Quit: Leaving.]
NihilistDandy has joined #ocaml
<jimmyrcom> can ocaml eval single expressions, like in haskell it's ghc -e 'succ 1'
zarus has quit [Ping timeout: 244 seconds]
diego_diego has quit [Quit: diego_diego]
diego_diego has joined #ocaml
roconnor has quit [Read error: Connection reset by peer]
mjonsson has quit [Quit: Leaving]
<mrvn> % echo '1+1;;' | ocaml
<jimmyrcom> thanks mrvn
<mrvn> % ocaml <(echo 'Printf.printf "%d\n" (1+1);;')
<mrvn> 2
Tobu has quit [Ping timeout: 272 seconds]
lamawithonel__ has quit [Remote host closed the connection]
Tobu has joined #ocaml
jimmyrcom has quit [Ping timeout: 245 seconds]
ankit9 has joined #ocaml
ankit9 has quit [Client Quit]
asdfhjkl has quit [Quit: Leaving]
andreypopp has joined #ocaml
ulfdoz has quit [Ping timeout: 252 seconds]
cdidd has joined #ocaml
emmanuelux has joined #ocaml
Tobu has quit [Ping timeout: 260 seconds]
Tobu has joined #ocaml
NihilistDandy has quit [Ping timeout: 245 seconds]
diego_diego has quit [Quit: diego_diego]
wagle has quit [Ping timeout: 245 seconds]
lopex has joined #ocaml
wagle has joined #ocaml
mcclurmc_ has quit [Read error: Connection reset by peer]
jonathandav has quit [Read error: Connection reset by peer]
jonathandav has joined #ocaml
ftrvxmtrx_ has quit [Quit: Leaving]
Cyanure has joined #ocaml
pango is now known as pangoafk
Submarine has joined #ocaml
Submarine has quit [Changing host]
Submarine has joined #ocaml
wagle has quit [Ping timeout: 248 seconds]
Submarine has quit [Ping timeout: 245 seconds]
zorun has joined #ocaml
ftrvxmtrx has joined #ocaml
ocp has joined #ocaml
wagle has joined #ocaml
albacker has joined #ocaml
albacker has quit [Changing host]
albacker has joined #ocaml
Cyanure has quit [Remote host closed the connection]
cago has joined #ocaml
silver has joined #ocaml
bobry has joined #ocaml
wagle has quit [Remote host closed the connection]
djcoin has joined #ocaml
wagle has joined #ocaml
Submarine has joined #ocaml
Tobu has quit [Ping timeout: 260 seconds]
avsm has joined #ocaml
hto has joined #ocaml
hto has quit [Client Quit]
ocp has quit [Ping timeout: 265 seconds]
hto has joined #ocaml
thomasga has joined #ocaml
milosn_ has quit [Ping timeout: 252 seconds]
Tobu has joined #ocaml
skchrko has joined #ocaml
ocp has joined #ocaml
avsm has quit [Quit: Leaving.]
avsm has joined #ocaml
thizanne has quit [Ping timeout: 245 seconds]
thizanne has joined #ocaml
Kakadu has joined #ocaml
Snark has joined #ocaml
KDr2 has quit [Remote host closed the connection]
lihaitao has joined #ocaml
NihilistDandy has joined #ocaml
avsm has quit [Quit: Leaving.]
avsm has joined #ocaml
NihilistDandy has quit []
milosn has joined #ocaml
_andre has joined #ocaml
ocp has quit [Ping timeout: 276 seconds]
Cyanure has joined #ocaml
lamawithonel has joined #ocaml
fantasticsid has quit [Ping timeout: 260 seconds]
kaustuv has joined #ocaml
fantasticsid has joined #ocaml
albacker has quit [Ping timeout: 246 seconds]
xenocons has quit [Ping timeout: 245 seconds]
eslg has joined #ocaml
eslg has left #ocaml []
lorill has joined #ocaml
Tobu has quit [Ping timeout: 272 seconds]
skchrko has quit [Ping timeout: 246 seconds]
Tobu has joined #ocaml
gildor has quit [Quit: leaving]
skchrko has joined #ocaml
jonathandav has quit [Read error: Connection reset by peer]
jonathandav has joined #ocaml
Tobu has quit [Ping timeout: 272 seconds]
avsm1 has joined #ocaml
avsm has quit [Ping timeout: 244 seconds]
Tobu has joined #ocaml
bobry has quit [Read error: Operation timed out]
gmcabrita has quit [Read error: Connection reset by peer]
lopex has quit [Write error: Connection reset by peer]
lihaitao has quit [Quit: Ex-Chat]
kerneis has joined #ocaml
kerneis has left #ocaml []
fantasticsid has quit [Remote host closed the connection]
jimmyrcom has joined #ocaml
andreypopp has quit [Ping timeout: 260 seconds]
bobry has joined #ocaml
NihilistDandy has joined #ocaml
gmcabrita has joined #ocaml
Kakadu has quit [Quit: Page closed]
mmajchrzak has joined #ocaml
mmajchrzak has quit [Ping timeout: 244 seconds]
<Drakken> Are there differences between Caml and OCaml beside the object system?
<adrien> Caml or Caml Light?
<adrien> there's a porting guide on caml.inria.fr; it's under the resources section iirc
<Drakken> whichever applies to the head and tail of an ocamllex file.
<Drakken> "The header and trailer sections are arbitrary Caml text enclosed in curly braces."
<adrien> ah
<Ptival> maybe it's just OCaml
<adrien> I think that they meant O too
<Ptival> it had so many names that not all sources are up-to-date with the quite recent decision to name it all OCaml
<Drakken> the typechecker doesn't seem to like plain strings after the arrows in a match expression.
<Drakken> "Error: This expression is not a function; it cannot be applied"
<Ptival> what is right after that?
<Ptival> did you forget a pipe or something? :)
<adrien> it can also happen if you have "a b" instead of "f a b"
<flux> match () with _ -> "hello" -> works
<mrvn> or f a g b instead of f a; g b
<Drakken> that's from [let x = match y with | foo -> "foo" | bar -> "bar" in print x]
<Ptival> (these braces ain't curly)
<Ptival> I never used ocamllex so I'm out of this discussion :)
<flux> well, first of all that's probably not doing what you expect. but it works for me, after patching it up: let y = "42" in let x = match y with | foo -> "foo" | bar -> "bar" in print_string x
<Drakken> actually, that should be Foo -> "foo" | Bar -> "bar"
<flux> you probably want this: match y with _ when y = foo -> "foo" | ..
<flux> oh, ok then nevermind
<mrvn> Drakken: sure that there shouldn't be a ; after print x?
<mrvn> Drakken: or a let () = before?
<Drakken> nope. that's the return expression in a function def.
lopex has joined #ocaml
<mrvn> and it should return unit?
<Drakken> yea, I guess so.
<mrvn> then I'm out too
Submarine has quit [Quit: Leaving]
Znudzon has joined #ocaml
<Drakken> oh cr@p
<Drakken> sorry, that was my fault :(
<mrvn> glad we could (not) help
ulfdoz has joined #ocaml
<Drakken> I was "factoring" the print function out of the match expression, but some of the args were format strings with another arg instead of a simple string.
<Drakken> So the typechecker thought I was trying to apply the format string to the other arg. :)
<Drakken> Always check your _OWN_ code first.
<Drakken> Especially when you're _ME_!
<flux> drakken, these are great situations to look into how to debug ocaml typechecking ;)
<flux> like, by annotating code, ..
kaustuv has left #ocaml []
diego_diego has joined #ocaml
<Drakken> hmm. that sounds so sensible...
cago has quit [Quit: Leaving.]
NihilistDandy has quit []
lorill has quit [Quit: Ex-Chat]
Tobu has quit [Ping timeout: 272 seconds]
joewilliams has joined #ocaml
silver has quit [Quit: I put on my robe and wizard hat]
ftrvxmtrx has quit [Quit: Leaving]
Kakadu has joined #ocaml
Tobu has joined #ocaml
emmanuelux has quit [Ping timeout: 245 seconds]
Submarine has joined #ocaml
Submarine has quit [Changing host]
Submarine has joined #ocaml
lihaitao has joined #ocaml
err404 has joined #ocaml
iago has joined #ocaml
diego_diego has quit [Quit: diego_diego]
avsm1 has quit [Quit: Leaving.]
Tobu has quit [Ping timeout: 260 seconds]
andreypopp has joined #ocaml
djcoin has quit [Quit: WeeChat 0.3.2]
Tobu has joined #ocaml
snearch has joined #ocaml
thomasga has quit [Quit: Leaving.]
Kakadu has quit [Quit: Konversation terminated!]
hto has quit [Quit: Lost terminal]
hto has joined #ocaml
ulfdoz_ has joined #ocaml
ulfdoz has quit [Ping timeout: 252 seconds]
ulfdoz_ is now known as ulfdoz
lihaitao has quit [Quit: Ex-Chat]
lihaitao has joined #ocaml
diego_diego has joined #ocaml
snearch has quit [Quit: Verlassend]
lihaitao has quit [Read error: Connection reset by peer]
lihaitao has joined #ocaml
lihaitao has quit [Client Quit]
andreypopp has quit [Quit: Quit]
albacker has joined #ocaml
albacker has quit [Changing host]
albacker has joined #ocaml
mcclurmc_ has joined #ocaml
gildor has joined #ocaml
Tobu has quit [Ping timeout: 272 seconds]
pangoafk is now known as pango
<ulfdoz> Alter, hoffentlich werd ich auch mal so alt. :)
<ulfdoz> ewin
<mrvn> Has anyone tried to add ocaml support to ccache?
albacker has quit [Quit: Leaving]
Tobu has joined #ocaml
diego_diego has quit [Quit: diego_diego]
asdfhjkl has joined #ocaml
emmanuelux has joined #ocaml
<flux> I think very few ocaml projects would really take benefit of that..
<flux> not to mention it would probably be slightly complicated
<flux> because ocaml .cmx files aren't pure functions of other ml/mli-files
<zorun> I reckon distcc support would be nice
Xizor has joined #ocaml
<zorun> but I also doubt many projects would really benefit fgrom it
<zorun> there aren't truly big projects (like a kernel…) in OCaml
<mrvn> ocaml is pretty big
<zorun> yeah, but it *really* doesn't compile well with a "make -j 2" or more
<zorun> I don't want to imagine how it would be with network latency
<mrvn> nor with ccache since it builds a first stage first
<flux> ocaml compiles pretty fast without caches
<flux> and if you're developing, typically bytecode binaries are sufficient, which reduces the amount of compliations (no deps due to cross-module inlining) and does less work anyway
<mrvn> I configured ocaml with: ./configure --with-pthread -prefix /usr -libdir /usr/lib/ocaml-4.0 -x11lib "/usr/lib/x86_64-linux-gnu" -mandir /usr/share/man -tkdefs "-I/usr/include/tcl8.5" -tklibs "-L/usr/lib -ltk8.5 -ltcl8.5" but it installs to /usr/lib/ocaml. any ideas?
ftrvxmtrx has joined #ocaml
thomasga has joined #ocaml
thomasga has quit [Client Quit]
<zorun> mrvn: which version?
<zorun> oh, well, 4.0
<mrvn> args, debian/rules runs sed to replace LIBDIR=.* with its own string instead of OCAML_STDLIB_DIR (which I changed to use -4.0 suffix)
<mrvn> rofl: Checking the sizes of integers and pointers...
<mrvn> Wow! A 64 bit architecture!
diego_diego has joined #ocaml
<mrvn> Does ocaml have a configure option to add a prefix or suffix to all its commands? I want the 4.0 build to use /usr/bin/ocamlc-4.0.
<adrien> probably in the cross-compiler patches
<adrien> as far as I'm concerned, I prefer to put such things in /opt to be able to switch very easily, and *for* *sure*
<adrien> brb, food
diego_diego has quit [Quit: diego_diego]
avsm has joined #ocaml
_andre has quit [Quit: leaving]
djcoin has joined #ocaml
<djcoin> Hi all; is there a way to get an expression evaluation printed ? As when i'm using the top level interpreter ?
<jonafan> IIRC both batteries included and janestreet's core can do it
Snark has quit [Quit: Quitte]
ulfdoz has quit [Ping timeout: 252 seconds]
<djcoin> jonafan: when you say batteries included, you mean from core libraries ?
<jonafan> looks like extlib can as well
<jonafan> no
<jonafan> they're seperate projects
<djcoin> okay, thanks !
<mrvn> Can I declare a anonymous external function in ocaml? Something that doesn't end up in the interface even if you have no mli file.
<Ptival> mrvn: hum, that's quite awkward
<Ptival> the answer is probably no
tnguyen has joined #ocaml
eaSy60 has joined #ocaml
eaSy60 has left #ocaml []
ftrvxmtrx has quit [Ping timeout: 265 seconds]
ftrvxmtrx has joined #ocaml
xenocons has joined #ocaml
<xenocons> question (silly): can the actual js_of_ocaml compiler that converts ocaml -> js, be compiled to js?
<jonafan> let me try
diego_diego has joined #ocaml
<jonafan> okay it's not easy to try because the version i have installed is native
<xenocons> i am updating lwt atm i should be able to try soon
Submarine has quit [Ping timeout: 265 seconds]
Tobu has quit [Ping timeout: 260 seconds]
<djcoin> Is assert function in ocaml kinda "special" ??
<djcoin> It seems I can compose this function with other
albacker has joined #ocaml
albacker has quit [Changing host]
albacker has joined #ocaml
<Ptival> djcoin: assert kinda has type 'a -> ()
<Ptival> err
<Ptival> bool -> ()
<djcoin> Ptival: I wanted to compose assert and a deep_equal function into assert_deep_equal
<djcoin> let foobar = assert (fun x -> true);;
<djcoin> oops. I meant compose
<Ptival> assert isn't 1st class though
<djcoin> let compose f g x = f(g x) ;; let foobar = compose assert (fun x -> true);;
<djcoin> Ahem okay
<djcoin> Why is that
<Ptival> does that work?
<djcoin> No
<djcoin> No prob; i will take 10 seconds and write my own assert function
<djcoin> weird tough
<djcoin> though*
<Ptival> Why is that? > maybe because of how it points you to the source of the assertion
<Ptival> and how it's optimized away for "assert false"
<Ptival> don't know though
<djcoin> Maybe, it's kind of a special function as it can be disabled with compiler flags
<djcoin> My own assertion fun is working :x
<Ptival> why is that?
<djcoin> Ptival: why is what ?
<Ptival> that your own assertion fun is not working?
<djcoin> It does work
<jonafan> let assert x = assert x;;
Tobu has joined #ocaml
<Ptival> :D
<Ptival> djcoin: sorry, misread
<Ptival> it's not usual that someone say "works" and ":x"
Cyanure has quit [Read error: Connection reset by peer]
skchrko has quit [Quit: ChatZilla 0.9.88.1 [Firefox 11.0/20120314111819]]
<djcoin> no prob
<djcoin> True :)
cdidd has quit [Remote host closed the connection]
NihilistDandy has joined #ocaml
avsm has quit [Quit: Leaving.]
Tobu has quit [Ping timeout: 272 seconds]
diego_diego has quit [Quit: diego_diego]
emmanuelux has quit [Remote host closed the connection]
albacker has quit [Ping timeout: 252 seconds]
Tobu has joined #ocaml
djcoin has quit [Quit: WeeChat 0.3.2]
err404 has quit [Remote host closed the connection]
Xizor has quit []
tnguyen has quit [Quit: ChatZilla 0.9.88.1 [Firefox 10.0.3/20120309135702]]
Znudzon has quit [Ping timeout: 245 seconds]
Tobu has quit [Ping timeout: 260 seconds]
avsm has joined #ocaml
<_habnabit> how exactly do you work with an (int, int_elt) bigarray? I tried setting the values (from C) to `Val_int(some_int)`, but that wasn't giving me the correct values
jmcarthur has quit [Read error: Connection reset by peer]
<adrien> no Val_ macros I think
<_habnabit> then why does the documentation say it's a different range than a nativeint?
<adrien> for [ let i = get ba 42 in ] I'd say
<_habnabit> ah
<adrien> basically, the ease of use when doing int bigarrays
<adrien> I _think_
<_habnabit> well, Val_int isn't the right thing to use, anyway
<_habnabit> I do wish it said which C types to use for each of those bigarray types :(
<_habnabit> but I should be able to use a long * for the value still?
<adrien> bah, crappy networking hardware
<adrien> read otherlibs/bigarray/bigarray_stubs.c in the OCaml sources
<adrien> considering the number of casts in caml_ba_get_N, I think they have to avoid integer promotion issues
<adrien> if you don't know what integer promotion is, look it up because it might well be the bug you're having
<_habnabit> the bug I was having went away when I stopped calling Val_int
<adrien> (Val_int(some_var_of_type_char) <- huge mistake)
<_habnabit> so I don't think that's it
<adrien> (because chars are signed)
<_habnabit> oh
<mrvn> adrien: a native int has one bit more precision than an int
<_habnabit> let me clarify how they were off
<_habnabit> one sec
<mrvn> adrien: and char is signed or unsigned depending on the arch. Use (u)int8_t.
<_habnabit> yeah, they were all as if it had been (val << 1) | 1
<adrien> mrvn: or "unsigned char" ;-)
<_habnabit> brb
<mrvn> adrien: no, that is much more to type and harder to read
<adrien> but I can safely say that char is signed by default on most archs currently; but anway, that was an example that bit me recently
<_habnabit> (and AFAIK that's how ocaml does int tagging, so..)
<adrien> mrvn: C99
<mrvn> _habnabit: accidentally yes, (val << 1) | 1 is how ints are stored.
<adrien> _habnabit: but read the file I've mentionned: it does what you want
<adrien> case CAML_BA_NATIVE_INT:
<adrien> return caml_copy_nativeint(((intnat *) b->data)[offset]);
<mrvn> adrien: wrong case, he has int
<adrien> case CAML_BA_CAML_INT:
<adrien> return Val_long(((intnat *) b->data)[offset]);
<adrien> sorry, offset wrong, it's almost 2 am and I need to fight paperwork and administration
<mrvn> I hate that there is Val_int and Val_long.
<adrien> (offset: mine; since the NATIVE_INT and CAML_INT cases are consecutive)
Tobu has joined #ocaml
<adrien> yup
<adrien> mlvalues.h (iirc) is a good read too
<mrvn> afaik docs all say to use Val_int but ocaml code uses Val_long.
<adrien> not all code from ocaml does
<mrvn> which makes it even worse
<adrien> when I look at that switch/case, there is one use of Val_long and 4 uses of Val_int
<mrvn> #define Val_int(x) Val_long(x)
<mrvn> #define Int_val(x) ((int) Long_val(x))
jmcarthur has joined #ocaml
<adrien> I'm not commenting on that because of http://en.wikipedia.org/wiki/LLP64#64-bit_data_models
<adrien> which should be enough to drive anyone crazy for something like ocaml
<_habnabit> okay, so, all I want to know is: if I define a bigarray with BIGARRAY_CAML_INT, what's the type of x that I should have if I do `x = Data_bigarray_val(my_bigarray)`
<mrvn> adrien: I think Val_long/Long_val means long long on LLP64
<mrvn> file:///usr/share/doc/ocaml/docs/ocaml.html/manual043.html#toc152
<mrvn> _habnabit: BIGARRAY_CAML_INT: 31- or 63-bit signed integers
<_habnabit> ... yes, I see that
<mrvn> _habnabit: which means Val_long / Long_val
<_habnabit> okay
<_habnabit> so it should be a value *, and assignment would be `x[i] = Val_long(y)`
<mrvn> yes
<_habnabit> k
<_habnabit> so why are there both Val_long and Val_int
<adrien> :-)
<mrvn> _habnabit: because longs are slower on small cpus
<_habnabit> okay, but there's no 'long' type in ocaml
<_habnabit> and it's spelled BIGARRAY_CAML_INT, not BIGARRAY_CAML_LONG
<_habnabit> so how am I supposed to know that I'm supposed to use Val_long
<mrvn> I guess Val_int should be used only for chars, units, constructor numbers or when you really know the number will be small enough for an int.
<mrvn> _habnabit: The Val_* makros are named after the C type, not the ocaml type.
<mrvn> _habnabit: see the definitions at the start of /usr/include/caml/mlvalues.h
<_habnabit> okay, so, I'm still not getting the same values between C and ocaml. pasting; hang on
<_habnabit> this is giving me values << 1 | 1 again
<mrvn> _habnabit: size_t is the wrong type.
<_habnabit> it has to be casted before it's given to Val_long?
<mrvn> _habnabit: No. Your problem is that you aren't extracting a value from the bigarray or inserting an ocaml int into the bigarray.
<mrvn> In the bigarray the ints are not tagged.
<_habnabit> okay, so how do I insert an ocaml int into the bigarray
<mrvn> sorry, didn't catch that before.
<mrvn> *res_ptr++ = *medoids_ptr++;
<xenocons> im thinking about using ocaml for my next project i think, what is the state of xml parsers? which is generally the the parser with the lightest syntax
<mrvn> When ocaml extracts the int from the bigarray it calls Val_long for you.
<_habnabit> okay.
<xenocons> XML Light looks interesting
<mrvn> _habnabit: but use intnat *medoids
cyphase has quit [Ping timeout: 252 seconds]