mbishop changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | Grab Ocaml 3.10.0 from http://caml.inria.fr/ocaml/release.html (featuring new camlp4 and more!)
<mbishop> Anyone here know Zheng Li and can tell him his site is busted? (stmlib.pdf doesn't work, and neither does STMlib documentation)
kilimanjaro has quit [Read error: 54 (Connection reset by peer)]
lucca has joined #ocaml
jao has quit []
JeffSmac has joined #ocaml
<JeffSmac> yay ocaml!
<JeffSmac> If ocaml counted as a foreign language, I'd be able to graduate sooner :(
* tsuyoshi is graduating in two weeks
<tsuyoshi> and then going to language school
<tsuyoshi> I guess that's a little ironic
<JeffSmac> I'm good at learning languages, but only in a private setting. I really, really don't like most natural language classes.
<JeffSmac> perhaps if someone taught natural languages like a programming language... :)
<tsuyoshi> well.. I find the hardest part to be speaking/listening
<tsuyoshi> which you don't need at all for a programming language
<JeffSmac> exactly
<tsuyoshi> the vocabulary (library) doesn't need to be memorized so much since you can just look it up when you need to
<JeffSmac> true
mwc has joined #ocaml
schme` has joined #ocaml
JeffSmac has quit []
schme has quit [Connection timed out]
benny__ is now known as benny
joshcryer has quit [Read error: 104 (Connection reset by peer)]
joshcryer has joined #ocaml
love-pingoo has joined #ocaml
pango has quit [Remote closed the connection]
pango has joined #ocaml
jao has joined #ocaml
<flux> hmm.. I've got loads of debug output in my program
<flux> I would like to conditionally compile them in, not wanting to have the overhead of generating output strings without printing them
<flux> well, actually, runtime enabling of them would be nice, but still, if the flag is false, I wouldn't want the overhead..
<flux> (overhead coming from constructs like let debug fmt = if debug_flag then Printf.printf fmt else Printf.ksprintf (fun _ -> ()) fmt)
<flux> any nice camlp4 module for me to do that?-)
<flux> (I guess it'd be a nice project for studying camlp4..)
<ulfdoz> what about laziness?
<flux> laziness?
<ulfdoz> iirc correctly, ocaml has a module for lazy computation.
<flux> debug (lazy (Printf..)) ?
<malc_> flux: let dbg = if debug then Format.fprintf Format.err_formatter else Format.ifprintf Format.err_formatter;;
<flux> that would be too much syntactic overhead IMO
<malc_> 3.10 material
<flux> malc_, yes, but let say I have this: dbg "set of inputs: %s" (string_of_set inputs)
<flux> malc_, it'll evaluate string_of_set even if the debug flag is disabled
<flux> even if it discards the result
<ulfdoz> imho, you want exactly laziness. ;)
<flux> that is one way of putting
<flux> it
<flux> what is the overhead of generating lazy values?
<flux> but it would still need some (very little) camlp4 magic to get rid of the syntactic cruft
<ulfdoz> usually only constructing the expression.
<ulfdoz> and a function pointer.
<flux> does it matter how complicated expression, or how many free variables the expression contains?
<ulfdoz> nope.
<flux> I'm thinking if debug_flag then .. else () is still going to be faster, though
<ulfdoz> It's similar to partial application.
love-pingoo has quit [Read error: 131 (Connection reset by peer)]
love-pingoo has joined #ocaml
malc_ has quit ["leaving"]
Smerdyakov has quit [Read error: 104 (Connection reset by peer)]
<ulfdoz> from my experiences with haskell, this concept works great.
<flux> a second thing I'd like would a DEBUG macro or something knowing which function it is in.. but that's not anymore trivial.
Smerdyakov has joined #ocaml
<ulfdoz> I think, preprocesser would be the only option. Anything else would require jumping around on the call-stack.
mwc has quit ["Lost terminal"]
love-pingoo has quit ["Connection reset by pear"]
screwt8 has quit [Remote closed the connection]
screwt8 has joined #ocaml
Demitar has quit [Read error: 113 (No route to host)]
ramkrsna_ has joined #ocaml
G_ has quit [Read error: 110 (Connection timed out)]
ramkrsna has quit [Read error: 110 (Connection timed out)]
malc_ has joined #ocaml
mikeX has joined #ocaml
ramkrsna_ is now known as ramkrsna
pango- has joined #ocaml
pango has quit [Remote closed the connection]
pango- is now known as pango
Mr_Awesome has quit ["...and the Awesome level drops"]
malc_ has quit ["Lost terminal"]
slipstream has joined #ocaml
slipstream-- has quit [Read error: 110 (Connection timed out)]
G has joined #ocaml
olegfink has joined #ocaml
<olegfink> hi, I have two questions
<olegfink> 0) Why a constructor isn't a function?
<olegfink> 1) Warning F: this function application is partial,
<olegfink> maybe some arguments are missing.
<olegfink> what does that mean?
<flux> 0) because. I think the rationale given by the ocaml people is that it isn't required and could make things messy. I miss it sometimes.
<olegfink> hehe
<olegfink> consider let (>>) x f =f x
<flux> 1) let's say you have a program let a b c = b + c let main () = a 5; Printf.printf "Done!n
<flux> \n";
<olegfink> then I can do stuff like [1;2;3] >> List.rev >> List.map (+1)
<flux> (without the trailing ;)
<flux> that will result in that warning
<flux> you are missing one argument
<flux> olegfink, that is all fine, although you might want to take operator precedency into account (it's in the manual)
<olegfink> but printf is a special function which has variable number of args
<flux> yes, printf works by magic
<olegfink> but I don't have it
<flux> you don't have what?
<olegfink> I don't have printf in my code
<olegfink> the warning shows about the first line in ^^^ snippet
<flux> well, I Don't know why you brought up printf
<flux> oh, my example didn't have anything to do with printf
<flux> it was just something to do after the a 5;
<flux> if there was nothing, no warning would be produced
<flux> so what's the type of Stack.push?
<olegfink> 'a -> 'a t -> unit
<flux> so it takes two arguments
<flux> you're giving it one
<flux> puzzle solved :)
<olegfink> arghhh
<olegfink> thanks
<flux> :)
<olegfink> but why doesn't it say about type mismatch?
<flux> what type mismatch?
<flux> the first argument is 'a
<flux> it can be anything
<olegfink> I mean it is 'a -> 'a t -> unit, but I use it as 'a -> unit
<olegfink> different type
<flux> not really, you use it as 'a -> ('a t -> unit) and discard the result
<olegfink> ah
<flux> if you were to type: let () = Stack.push (Node ..) in .. then you would be using it as 'a -> unit
<flux> all functions of form 'a -> 'b -> 'c -> 'd etc are the same as 'a -> ('b -> ('c -> 'd))
<olegfink> aha
<olegfink> finally I've written a long function of type string -> unit which doesn't do anything with the world. Very cool.
<flux> is it possible to write a camlp4 extension such that it can be used with ocamlfind ocamlc -package pa_foo -syntax pa_foo .. ? at present I must write .. -syntax camlp4o,pa_foo, and I feel it should be able to work that out by itself..
<flux> it maybe it requires it due to user might want to use revised syntax. (I don't know how that's going to work..)
Oxylin has joined #ocaml
shekmalhen has quit ["Méritez votre liberté, fainéants"]
G_ has joined #ocaml
G has quit [Nick collision from services.]
G_ is now known as G
Oxylin has quit [Client Quit]
digger has joined #ocaml
<digger> Err, what would be the easiest way to convert pairs of unsigned 8 bit bigarray integers to unsigned 16 bit bigarray integers?
<flux> digger, does reshape work for you? I don't know, I've never used it :)
<digger> Um, isn't that conversion between dimensionality not types?
<flux> uh, right, I glanced the signature too briefly
<flux> perhaps you can use Obj.magic :)
<flux> so would the arrays be laid similarly in the memory?
<digger> I'm not sure how that works, googling...
<flux> avoid Obj.magic at all cost, really
<digger> ...getting that impression...
<digger> No, pairs would be pulled from a bigarray and converted.
<digger> Contiguity of several numbers of different sizes is required =(
<digger> ok found a dozen articles on how obj.magic sucks but none telling me how to use it =/
<flux> my only 'legal' use of Obj.magic goes like: let int_of_fd (fd : Unix.file_descr) : int = Obj.magic fd, and that only works because I guessed the internal representation of fds properly (I guess I should look at the source some day ;))
<digger> ok found a bit vector thing but i'm not sure how hacky and/or slow it is
<digger> I could just use big numbers but then it don't fit in ram
<digger> and I could get more ram but I'm too poor for a new computer
<flux> :)
<digger> well that would be a lot of ram. i'd need like 12 gigs.
<digger> so, too poor
<flux> maybe you could distribute the algorithm!
<flux> what are you doing?
<flux> (albeit I must say memory consumption optimization can be nice for performance too in such cases)
<digger> crunching genomes
<digger> maybe i should use c for this part
<digger> =( =( =( =(
<digger> Some people want to solve a problem by using an additional language. Now they have two problems.
<digger> whoops now my internet is breaking too
<flux> ooh, this looks really useful if you're writing camlp4 extensions: http://wwwtcs.inf.tu-dresden.de/~tews/ocamlp4/qo_doc.html
<flux> (a similar one was wishlisted for ocaml 3.10.0..)
<digger> So what do you do with ocaml flux?
<flux> some freetime stuff (modeemi.fi/~flux/goba), some work stuff
<flux> (the first not having been updated for a while)
<digger> i have a game i want to make too
<digger> it involves two players navigating a fractal
<digger> little mo abstract
<flux> a bit, yeah :)
<digger> but should have a good ratio of visual quality to loc =)
<flux> what would be the game goal?
<digger> keeping a point on a color
<digger> well gotta go
<digger> bye
<flux> bye
digger has quit []
G_ has joined #ocaml
love-pingoo has joined #ocaml
G has quit [Connection timed out]
seafood has joined #ocaml
G has joined #ocaml
Demitar has joined #ocaml
kelaouchi has quit ["leaving"]
mikeX has quit ["leaving"]
pango has quit [Remote closed the connection]
seafood has left #ocaml []
Demitar_ has joined #ocaml
Demitar has quit ["Burn the land and boil the sea. You can't take the sky from me."]
pango has joined #ocaml
jao has quit []
love-pingoo has quit ["Leaving"]
jacobian has joined #ocaml
benny_ has joined #ocaml
benny has quit [Read error: 60 (Operation timed out)]
benny_ is now known as benny
<tsuyoshi> I have a friend who is doing some genome code in c
<tsuyoshi> and she's having trouble because she's allocating 3 gigs for an array but osx starts going really slow for some reason when a process does that
romanoff1 has joined #ocaml
<tsuyoshi> she's not much of a coder so I suspect it's not really necessary to have the entire array in memory at once.. but she won't tell me what exactly she's doing
love-pingoo has joined #ocaml
<jlouis> heh
<jlouis> is that a 32bit or 64 bit arch?
<tsuyoshi> 64 bit
<tsuyoshi> I think the 64 bit support in osx is lacking somehow
<jlouis> tsuyoshi: I do not know how FreeBSD like it is, but in FreeBSD, by default, you will begin swapping when the process goes above 512Mb irregardless of the amount of memory you have
<tsuyoshi> oh really?
<jlouis> That may also be a concern
<jlouis> you may want to play with kern.maxdsiz, kern.dfldsiz, kern.maxssiz on a FreeBSD yes
<tsuyoshi> I don't know why you would put 4 gigs in a mac.. it's insane
<jlouis> /boot/loader.conf
<jlouis> to run MLton, but of course ;)
<tsuyoshi> better to run it on a better os
<jlouis> ;)
<jlouis> I do not think OSX is particulary optimized to do heavy-duty disk I/O and stuff like that
<jlouis> but I really do not know
mnemonic has joined #ocaml
smimou has joined #ocaml
<pango> ulfdoz: lazy is not just deferred evaluation, it "caches" the result of evaluation too; Plain (fun () -> expr) may be better to just get deferred evaluation
<ulfdoz> pango: Ehm, Ocaml can't cache, you could have side effects.
<pango> ulfdoz: of course it does, that's part of OCaml semantics
<pango> # let x = lazy (print_endline "I has here") ;;
<pango> val x : unit lazy_t = <lazy>
<pango> # Lazy.force x ;;
<pango> I has here
<pango> - : unit = ()
<pango> # Lazy.force x ;;
<pango> - : unit = ()
<ulfdoz> are you sure, that isn't the binding, instead of caching?
<ulfdoz> More in the sense of simplification than caching.
<pango> internally, a lazy value is like a reference to a sum type
<ulfdoz> pango: And actually this behavior makes sense. There is no reason to do the possibly expensive computation of x twice.
<tsuyoshi> if you wanted to do it twice, you might as well just use a function
<pango> sure it has its uses, but I don't think it's the right tool for flux needs in this case
<ulfdoz> he wanted to avoid to construct the (), considering this case.
<ulfdoz> s/construct/compute/
<pango> then (fun () -> expr) may be enough
<ulfdoz> if expr is easy to compute, I agree.
<pango> if the expression is a debugging text in a loop, you want it to be reevaluated each time
<pango> otherwise it's not only faster, but also incorrect
<ulfdoz> for recursion, that should work. Dunno about scoping of imperative loops in ocaml.
<pango> even if it works with enough care, it would be fragile
<pango> better use a mecanism that really matches the need
jao has joined #ocaml
screwt8 has quit [Read error: 104 (Connection reset by peer)]
Submarine has joined #ocaml
bluestorm_ has joined #ocaml
Demitar has joined #ocaml
screwt8 has joined #ocaml
Mr_Awesome has joined #ocaml
the_dormant has joined #ocaml
JeffSmac has joined #ocaml
JeffSmac has quit []
JeffS has joined #ocaml
jacobian has quit [Remote closed the connection]
JeffS has left #ocaml []
pantsd has quit [Connection reset by peer]
pantsd has joined #ocaml
the_dormant has quit ["Au revoir"]
olegfink has quit [Read error: 104 (Connection reset by peer)]
olegfink has joined #ocaml
Optikal__ has quit []
mwc has joined #ocaml
screwt8 has quit [Remote closed the connection]
screwt8 has joined #ocaml
benny99 has joined #ocaml
benny99 has left #ocaml []
smimou has quit ["bli"]
romanoff1 has left #ocaml []
mnemonic has quit ["Lost terminal"]
bluestorm_ has quit ["Konversation terminated!"]
JeffSmac has joined #ocaml
slipstream-- has joined #ocaml
slipstream has quit [Read error: 60 (Operation timed out)]
mwc has quit ["Lost terminal"]