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
<thelema> gildor: hope you're asleep, but for packages providing a program (is_program=true), the program is assumed to be the name of the package
<thelema> gildor: more specifically: let test_prog (p, _v) = Sys.command ("which " ^ p.id) = 0
alexyk has joined #ocaml
alexyk has quit [Client Quit]
lamawithonel_ has quit [Ping timeout: 276 seconds]
lamawithonel_ has joined #ocaml
MUILTFN has quit [Ping timeout: 248 seconds]
lamawithonel_ has quit [Read error: Connection reset by peer]
adrien has quit [Ping timeout: 276 seconds]
Asmadeus has quit [Ping timeout: 250 seconds]
arubin has joined #ocaml
MUILTFN has joined #ocaml
lopex has quit []
oriba has left #ocaml []
mfp has quit [Ping timeout: 246 seconds]
wtetzner has joined #ocaml
enthymeme has quit [Quit: rcirc on GNU Emacs 23.1.1]
mfp has joined #ocaml
ymasory has quit [Quit: Leaving]
ymasory has joined #ocaml
sgnb has quit [Read error: Operation timed out]
sgnb has joined #ocaml
joewilliams is now known as joewilliams_away
MUILTFN has quit [Ping timeout: 276 seconds]
BiDOrD has quit [Ping timeout: 250 seconds]
enthymeme has joined #ocaml
joewilliams_away is now known as joewilliams
* thelema wonders if some ocaml records can be nested, so that their representation is flattened
<thelema> I'm thinking the GC might have issues with that, as the inner record would need its own GC header, but this just takes one slot in the flattened record
ymasory has quit [Remote host closed the connection]
<jld> The GC bits are the bottom two bits of the header word, right? So... whether the header is taken as an int or a pointer would depend on how the GC felt about it.
<jld> That, and it might not appreciate non-disjoint objects.
joelr has joined #ocaml
ymasory has joined #ocaml
lamawithonel has joined #ocaml
lamawithonel has quit [Remote host closed the connection]
<eye-scuzzy> moin
ikaros has joined #ocaml
arubin has quit [Quit: arubin]
ulfdoz has joined #ocaml
joewilliams is now known as joewilliams_away
myu2 has joined #ocaml
ulfdoz has quit [Ping timeout: 250 seconds]
enthymeme has quit [Quit: rcirc on GNU Emacs 23.1.1]
Cyanure has joined #ocaml
<joelr> moin
<joelr> i was actually able to help someone with a functor typing problem. woot!
Cyanure has quit [Ping timeout: 250 seconds]
philtor has quit [Ping timeout: 276 seconds]
<gildor> thelema: ok, so if the package ocaml-menhir, provides a program menhir, the pkg/info should be named menhir ?
ikaros has quit [Quit: Leave the magic to Houdini]
adlsaks has joined #ocaml
ski__ is now known as ski
yezariaely has joined #ocaml
yezariaely has left #ocaml []
Snark has joined #ocaml
<joelr> why doesn't this work in 3.12? let _ = Simple.main (module Client) (module Server) (module Config)
<joelr> it works in 3.13
<rproust> joelr: you are using 3.13?
<joelr> rproust: yeah
<joelr> by accident
<joelr> great angst now among my peers :D
<joelr> is 3.13 released?
<rproust> no
<joelr> yeah, i thought so
<sgnb> joelr: you cannot use 3.13 "by accident"...
<joelr> you can when you are me
* rproust don't want to know about the accident
<joelr> i had it built from source a few months ago and kept using it without thinking much about it
<rproust> You'll get better help from this channel using the lattest release rather than the cutting edge out of repo version
<joelr> my debian-using colleagues happen to prefer installing the latest released version :-(
<joelr> rproust: i know, i know
<rproust> but there's almost nothing listed for 3.13
<sgnb> unfortunately, Debian (and Ubuntu) are stuck with 3.11.2 for the time being :-(
<rproust> isn't 3.12 in sid?
<sgnb> no
<rproust> well, you can use godi with -section 3.12
emmanuelux has quit [Read error: Connection reset by peer]
<sgnb> I (kind of) maintain a repository of unofficial packages with 3.12.0, but the latest new about making it official is http://bugs.debian.org/cgi-bin/bugreport.cgi?msg=15;bug=618871
<sgnb> joelr: I think in 3.12, you have to give the module type when using first-class modules (as in Simple.main (module Client : CLIENT) ...) whereas this restriction has been lifted in some cases in 3.13
<kaustuv> Is the GADT branch going to be in 3.13?
vivanov has joined #ocaml
sepp2k has joined #ocaml
<gildor> kaustuv: I think Xavier could consider GADT for 3.13, but this is not 100% sure
rossberg has quit [Remote host closed the connection]
<mrvn> gildor: That would allow to say that a function a -> b is actually A_int -> B_int | A_float -> B_float?
<flux> gildor, have the GADT patches been tested 'for real'?
<gildor> flux: I think they are considering Lenormand patch
<gildor> mrvn: ^^^
<gildor> don't know if it has been tested for real
<gildor> (not by me for now)
<gildor> but come to OCaml Meeting 2011, Xavier would probably told us about that ;-)
<gildor> (shameless ads)
<rproust> gildor: isn't the registration deadline in a week (more ad) and goes through http://ocaml-meeting.forge.ocamlcore.org/2011-paris/reg_add (more and more)
ttamttam has joined #ocaml
<gildor> rproust: you are right, only one week left ;-)
<gildor> does anybody mind if I put a link into the topic ?
<gildor> topic
92AACO82W has joined #ocaml
robinnn has joined #ocaml
robinnn has quit [Remote host closed the connection]
92AACO82W has quit [Remote host closed the connection]
robinnn has joined #ocaml
robinn has joined #ocaml
robinn has quit [Remote host closed the connection]
<f[x]> > have the GADT patches been tested 'for real'?
<f[x]> the correct question of course is : have I tested GADT patches 'for real'?
<f[x]> :)
philed has joined #ocaml
<philed> Is there any way to find out whether there is data available in an input_channel so that a read can happen without blocking?
ttamttam has quit [Quit: ttamttam]
lopex has joined #ocaml
<philed> Ah never mind. Found the "set_nonblock" function.
vivanov has quit [Quit: leaving]
<flux> philed, it's not a good idea to mix non-blocking io with buffering io functions
ttamttam has joined #ocaml
edwin has joined #ocaml
<mrvn> philed: you probably want to use Unix.file_descr directly.
BiDOrD has joined #ocaml
Obfuscate has quit [Ping timeout: 240 seconds]
myu2 has quit [Remote host closed the connection]
<rproust> philed: or Lwt
vivanov_ has joined #ocaml
Asmadeus has joined #ocaml
vivanov_ has quit [Quit: leaving]
dnolen has joined #ocaml
dnolen has quit [Excess Flood]
vivanov has joined #ocaml
dnolen has joined #ocaml
_andre has joined #ocaml
joelr has quit [Quit: joelr]
Asmadeus has quit [*.net *.split]
mfp has quit [*.net *.split]
mattam has quit [*.net *.split]
<kaustuv> testing if a file descriptor has data and then reading from it in a different syscall does not guarantee non-blockingness unless you know that nothing else is also reading from that descriptor
Asmadeus has joined #ocaml
mfp has joined #ocaml
mattam has joined #ocaml
<mrvn> if it is non blocking then you might just end up with 0 byte even if you tested that there is something to read.
<flux> no, you will get EAGAIN
<flux> 0 indicates end of file
<flux> well, maybe you meant that
<flux> kaustuv, it's sort of risky business for multiple thrads of control to read from a single socket anyway, unless you're aware of the situation..
<flux> but in complicated program it may happen by accident if you have certain optimizations
<kaustuv> not just multiple threads of control -- some other process could be reading from that fd and this fact can be hidden from you in fairly intricate ways
mfp has quit [Read error: Operation timed out]
<flux> in my vocabulary process is a thread of control :)
<rproust> Lwt has an IO module with such controls (number of buffered chars)
mfp has joined #ocaml
<kaustuv> except in this case it is not a subthread. Indeed, the thing that fork()d you could be competing on the fd
<rproust> it is not necessary to use this IO module because of the coop thread model, but it can be usefull
<philed> flux: Seems this is much more subtle than I thought. In this case, the file-descriptors are the ends of pipes that I create in Ocaml and which begin the stdin and stdout of an external process. So I should have exclusive read/write on them, right?
<flux> philed, yes, but if you use buffered functions for it, the following can happen:
<flux> 1) you request to read 42 bytes
<flux> 2) but input function fills its buffers (everything that fits and is available) and reads 50 bytes
<flux> 3) you check if the fd is ready for reading which it is not
<flux> 4) you never see the remaining 8 bytes
<mrvn> philed: you create the pipes, you fork and then you close the read/write side of the pipes respectively in parent and child before the child execs the command.
<flux> philed, so you should never mix buffered IO (as provided by the standard library) and non-blocking IO
<rproust> philed: if the program is not to big, you can convert it to Lwt which will simplify this kind of things greatly
<mrvn> flux: In my IO buffer module I have a function to test if x bytes are present. If the buffer already has them it says true, if not it tries to read non-blocking, if it still doesn't have enough it says false.
<rproust> philed: if it's only yhe begining of a big program you should consider the possibility too
<philed> Hmm...okay, I'll have a look at lwt.
<philed> It's only a small program.
boscop__ has joined #ocaml
<rproust> philed: if you've already used monads it's very easy, if not you'll have a few difficulties
<philed> I've only used monads in Haskell.
<rproust> it's the same
<rproust> you basically do (expression that may block >>= fun result -> other expression using result)
myu2 has joined #ocaml
<rproust> and you just replace Unix by Lwt_unix
<rproust> Lwt_unix takes care of making non blocking system calls and schedulling another "thread" while waiting
<philed> Ah cool. I'll give it a try!
haelix_ is now known as haelix
<flux> it gets slightly more involved if you perform blocking operations inside List.iter, .map, etc
<rproust> there's Lwt_list.iter_{s,p}
<rproust> and the type checker helps you spot these
rossberg has joined #ocaml
Obfuscate has joined #ocaml
ikaros has joined #ocaml
<kaustuv> lwt assumes as POSIX (+libev) environment, right?
<rproust> yes
<diml> kaustuv: in the development version, you can use select instead libev, it even works on windows (even with pipes)
joelr has joined #ocaml
adrien has joined #ocaml
Yoric has joined #ocaml
<joelr> how do you do this? let [a;b;c|_] = [1;2;3;4;5;6;7];;
<joelr> e.g. grab the first few elements of a list
<joelr> using match, i guess
<diml> let (a :: b :: c :: _) = [1;2;3;4;5;6;7]
<joelr> ah! :: is it
<mrvn> and don't forget to handle match failures
<joelr> indeed
Julien_T has quit [Remote host closed the connection]
avsm has joined #ocaml
edwin has quit [Ping timeout: 250 seconds]
<kaustuv> let [a;b;c] = List.take 3 [1;2;3;4;5;6;7] --- this would raise Failure instead of Match_failure. Match_failure is something you generally don't want to catch in your code.
bbc has joined #ocaml
<thelema> jld: the gc uses the bottom 1 bit of non-pointers to know it's a non-pointer and the whole word before an object to determine the length and type of that object
<rproust> kaustuv: wouldn't it raise a warning at compile time? let (a, b, c) = match … with | a::b::c::_ -> (a, b, c) | _ -> raise CustomExc in
<thelema> gildor: yes, a package ocaml-menhir would expect a binary named ocaml-menhir or a findlib package ocaml-menhir.
<mrvn> kaustuv: let (a,b,c) = ... you mean?
<thelema> rproust: nothing raises at compile time
<rproust> thelema: not an exception, a compilation warning
<rproust> like Warning, this match case is not exhaustive
<mrvn> rproust: not with | _ -> ...
<rproust> mrvn: and for let [a;b;c] = List.take 3 [1;2;3;4;5;6;7]?
<rproust> it probably does
<mrvn> rproust: # let [a;b;c] = [1;2;3];;
<mrvn> Warning P: this pattern-matching is not exhaustive.
<mrvn> What exactly would be the point of List.take in the above?
<kaustuv> Have you tried reading what I wrote above?
<rproust> different exception at runtime
<mrvn> I was thinking: let [a;b;c;_] = [1;2;3];;
<mrvn> But: Exception: Match_failure ("", 1, 4).
<mrvn> The _ can't match [] in that syntax.
<mrvn> let a::b::c::_ = [1;2;3];; works though
<gildor> thelema: not sure of your yes, in fact
<gildor> thelema: if the binary is called menhir, is pkg/info/menhir ok ?
<thelema> yes, binary-name = menhir ==> package-name = menhir
<gildor> perfect, this what I have done
<gildor> thelema: FYI, working on findlib version
<thelema> if we needed otherwise it could be arranged, but this seems simple and effective enough
<gildor> that is effective, just want to be sure
<thelema> btw, oasis-db seems t be assuming tarballs
vivanov has quit [Ping timeout: 240 seconds]
<thelema> the first download file is a tar.bz2 from the URL, but the link says .tar.gz
robinnn has quit [Remote host closed the connection]
<gildor> thelema: oops
<gildor> a bug
edwin has joined #ocaml
<gildor> thelema: have you 5 minutes to go through the latest oasis-db/odb version
<gildor> thelema: hum, "deps=", don't parse ?
<thelema> it should now, unless 've not pushed that fix
<gildor> ok, didn't check it live
edwin1 has joined #ocaml
edwin has quit [Disconnected by services]
edwin1 is now known as edwin
<gildor> I have just deploy the latest version of oasis-db
<thelema> Error
<thelema> Don't know what to do with timezone 'Singapore'
<thelema> heh.
<gildor> thelema: argh
<gildor> need to recompile with ocamlcore-api before deploying ;-)
<gildor> thelema: refresh!
<thelema> the admin page seems the same to me
<gildor> I worked on the content of pkg/info
<gildor> thelema: or do you mean that you still get the singapore error ?
<thelema> no, singapore went away
<thelema> I'll check out the info files next
<gildor> e.g. fastrandom is_libaryr=true is_program=false
<gildor> and oasis deps=expect(>=0.2)
<gildor> humm, just realize that I can do a more direct translation of deps
<gildor> (and get rid of the unsolved comment)
<thelema> hmm, is there a per-repository (testing/stable/unstable) info dir?
<gildor> thelema: yes
<gildor> and in fact, we limit the pkg dir to the tarball needed
<thelema> sounds good
<thelema> well, except old urls die...
<gildor> forget to add ocamlify to oasis deps
<gildor> (i.e. to add tools)
<gildor> what old url ?
<thelema> a non-current (per repo) package is no longer available at its previous uri
<thelema> s/ounit/oUnit/ ?
<gildor> thelema: you asked me to match findlib name, so it matches findlib name (oUnit in this case)
<thelema> also, wouldn't hurt to have some coloring based on unmet deps in the repo
<thelema> it doesn't match findlib name, its package name is "ounit" which isn't its findlib name of "oUnit"
<gildor> in the admin panel ?
<thelema> yes, coloring in the admin panel
<gildor> ok, will see what I can do for the unmet deps
<thelema> yes, the tarball name isn't the package name
<thelema> the tarball could be named anything, the important thing is the name of the package in the info directory
<thelema> yes
<gildor> ah ok, so everything fine
<kaustuv> findlib really needs to be case insensitive
<thelema> currently many of your info files have a comment "#unsolved ... oUnit ..."
<gildor> there was an error with _oasis extraction in 0.1.0~alpha1 and it doesn't have extracted the _oasis file
<thelema> this change should put the ounit dep on the deps= line
<gildor> i.e. for odn and oUnit this is the case
<gildor> wait a sec, I solve the #unsolved issue
<gildor> redeploy
<thelema> gildor: where was the admin link again?
* thelema bookmarks it this time
<gildor> thelema: ok, ounit -> oUnit (reextracted the _oasis file)
<gildor> and unsolved should have gone away
<gildor> still missing ocamlify in the deps of oasis
adlsaks has quit [Ping timeout: 260 seconds]
<thelema> let pkg_rx = Str.regexp "<a href=[^>]+>\\([-a-zA-Z0-9]+\\)</a>"
<thelema> <a href=\"../../unstable/pkg/info/posix_resource\">posix_resource</a>\n...
<thelema> ah, that's what I'm missing, underscores in packages
<thelema> gildor: do we need underscores in package names?
<gildor> that is allowed by findlib, so I suppose we need them
<thelema> and some packages (batteries included) use them in sub-package names, but not in proper package names
<thelema> Since having both _ and - is confusing, I suggest we filter both to -
<thelema> channel: does anyone have a findlib package that has a _ before the first .?
<gildor> for my own pkg list: ocsigen_xhtml bin_prot
<rproust> thelema: js_of_ocaml.syntax
<kaustuv> also bin_prot
<kaustuv> err, bin_prot.syntax
<gildor> vs type-conv xml-light ocamlcore-api rpc-auth-dh rpc-generator nethttpd-for-netcgi easy-format gettext-camomile
<gildor> thelema: but is this really a big deal ?
dnolen has quit [Quit: dnolen]
edwin1 has joined #ocaml
edwin has quit [Disconnected by services]
edwin1 is now known as edwin
ymasory has quit [Remote host closed the connection]
<thelema> blah. no, not a big deal, but possibly room for improvement
<gildor> thelema: do you build doc and run test ?
<thelema> not at the moment
<thelema> not hard to add
<gildor> ok, so I just ignore the deps of this two
<thelema> yes, for the moment
<gildor> not very hard indeed, but KISS
<thelema> soon we'll add testing and doc gen as standard steps. but let's make it work first
scooty-puff has joined #ocaml
<scooty-puff> is this a good or correct way to define a to_int function on peano numbers?
<scooty-puff> also, how are functors allowed to be reused?
<scooty-puff> i.e., using code from the paste, i do module Two = S(S(Z))
robinnn has joined #ocaml
bohanlon has quit [Quit: leaving]
<scooty-puff> can someone else's definition of Two interoperate if made up of the same functor compositions?
robinn has joined #ocaml
robinn has quit [Remote host closed the connection]
<scooty-puff> also, can i expect the value of an S or Z.to_int to be computed at compile time?
<scooty-puff> (not that its significant, just wondering)
<gildor> thelema: deps=unix,pcre,odn(>=0.0.3),ocamlyacc,ocamllex,ocamlify,ocamlgraph,...
<gildor> ah hem, is is a big problem to depends on ocamlyacc/ocamllex/make ?
<gildor> (I mean this is correct because oasis depend on them, but are you ok with that)
<thelema> well, I don't think that's huge, just put up a ocamlyacc info file (doesn't need a tarball=) that just says "is_program=true"
<thelema> and odb will check for the ocamlyacc executable and fail if it's not found
<thelema> it'll fail wierdly at the moment, but that case can have a proper error message attached
lamawithonel has joined #ocaml
<gildor> thelema: I'll add a db where you can define external program
<gildor> (through the admin panel)
avsm has quit [Quit: Leaving.]
<thelema> Sure. I don't think there'll be that many, but okay.
lopex has quit []
DimitryKakadu has joined #ocaml
ymasory has joined #ocaml
lamawithonel has quit [Read error: Connection reset by peer]
lamawithonel has joined #ocaml
fraggle_ has quit [Ping timeout: 250 seconds]
avsm has joined #ocaml
ankit9 has quit [Read error: Connection reset by peer]
ymasory has quit [Read error: Operation timed out]
<scooty-puff> is there a type-indexed array library, in the spirit of boost's (and now the std?) array?
<scooty-puff> i had been planning on writing one, using peano numbers for the length
<scooty-puff> i.e. array<typename T, std::size_t N>
<scooty-puff> module Make(Num: NumType) sig type 'a t ... end
<thelema> array.(Obj.magic i) works for flat enums
<thelema> s/enums/variants/
<thelema> but in general, there's no way to have an array indexed by trees
<scooty-puff> ok
<thelema> (for example)
<scooty-puff> i guess what i really mean is an array where the length is guaranteed to be some value at compile time
<thelema> by flat variants, I mean type foo = A | B | C | D | ... without any "of bar"
<scooty-puff> o, i think i see - using data constructors vs. types
<thelema> ah, not indexed by an arbitrary type, but fixed size... We call those tuples
<scooty-puff> yeah, had planned on that, but what i really need is a float array (to be nicer to the heap) and to guarantee some sizes line what, whatever they may be
<thelema> but when the fixed size isn't statically known... IIRC, someone did some nearly-dependent-type stuff to make this happen
<gildor> thelema: external program management, done
<scooty-puff> dependent types would be great, or atleast more flexible
<gildor> thelema: working on unresolved deps
<thelema> gildor: great
<thelema> the unresolved deps will make staging unstable/testing/development *much* easier, I expect
<gildor> thelema: what about a small icon next to the repo version with a link to explanation at the end of the panel
<thelema> gildor: works for me.
* gildor start to work on this
<scooty-puff> maybe a stupid question, but: if i have some series of functors S(S(Z)).to_int, where to_int for Z is 0, and for S(P) is P.to_int + 1, can i expect the compile to insert the right value at compile-time?
<scooty-puff> (had asked a very similar question earlier)
<scooty-puff> perfect!
<gildor> thelema: ps, source code for ExtODB.ml (the part integrating ODB with OASIS-DB = 1171 LoC for now)
<thelema> scooty-puff: no, the ocaml compiler won't inline functors for you.
<thelema> gildor: I'm happy I've not cost you a lot of code complexity
<scooty-puff> thats a shame, at least in this case, its hopefully executed only once
edwin has quit [Ping timeout: 260 seconds]
<thelema> gildor: FWIW, odb.ml is 1488 LoC
<gildor> thelema: oasis-db is 10kLoC now
<gildor> thelema: but all the CLI stuff are not yet coded
DimitryKakadu has quit [Read error: Connection reset by peer]
Cyanure has joined #ocaml
bbc has quit [Quit: leaving]
<joelr> <- thinks all the OMake, OCamlMakefile, etc. projects should move to Oasis
<thelema> joelr: oasis needs to prove itself capable of handling all the complexity handled by those systems
<gildor> joelr: thx
ymasory has joined #ocaml
<gildor> thelema: oasis is just a toplevel for all these build system
<joelr> thelema: i heard on the grapevine that some heavy-duty ocaml shop is paying gildor to improve oasis ;-)
<gildor> thelema: oasis itself doesn't claim to be a build system
<joelr> <- also thinks oasis hacking should extend into ocamlbuild when needed
<gildor> joelr: indeed, my sponsor is Jane Street (this is displayed on the oasis-db website)
<joelr> oh, allright
<joelr> so if it's good for jane st, it should be good for others
<thelema> gildor: yes, but it does claim to provide an abstraction layer to eliminate the need for using these other build systems directly
<gildor> joelr: but it only account half of the work on it, the rest is OCamlCore SARL own fund
<joelr> gildor: which is a big way of saying "my own time" :D
DimitryKakadu has joined #ocaml
<gildor> thelema: just as odb, it claims to help ignore 80% of the underlying build system, but for tricky use case, you'll have to go deeper
<gildor> joelr: it says my own time, in a business way ;-)
fraggle_ has joined #ocaml
<joelr> is this a good exception name to use with web server header parsing exception Header_parsing_error?
<joelr> or should i say _exn instead of _error?
<joelr> or something else?
<thelema> gildor: yup, which I approve of (in theory, although I've yet to get into the details of using oasis to generate a build system)
<thelema> joelr: _error is fine
<joelr> gildor: you an be informal here :D
<joelr> gildor: i think the biggest addition to oasis that i want is the ability to define your own variables and pass them down to ocamlbuild
edwin has joined #ocaml
ttamttam has quit [Remote host closed the connection]
edwin1 has joined #ocaml
edwin has quit [Disconnected by services]
<gildor> joelr: still thinking about it, it will probably a new "Variable XXX" section
<gildor> but not before 0.3.0
<joelr> gildor: awesome
<gildor> which will translate to --with-XXX "mystring" for configure
<joelr> gildor: noooooooo
<joelr> please don't do that
<joelr> i mean, please make it simpler ;-)
<gildor> like what ?
<joelr> please make it magical
<joelr> like ... i don't know. but being able to say Foo: bar in _oasis would be a great start
<joelr> just like you can say ByteOpt: ... , etc
<joelr> should i prefer a StringMap to a hash table?
DimitryKakadu has quit [Remote host closed the connection]
<gildor> the point is that you should not be able to edit _oasis when distributed
<joelr> gildor: i agree with you but i'm not distributing projects with oasis. i'm consuming the internally so i edit _oasis a lot
mattam has quit [Ping timeout: 252 seconds]
<joelr> right
edwin1 has quit [Ping timeout: 240 seconds]
lopex has joined #ocaml
mattam has joined #ocaml
DimitryKakadu has joined #ocaml
avsm has quit [Quit: Leaving.]
<hcarty> joelr: StringMap vs Hashtbl - it depends on what you are doing. Hashtbl can be faster, while StringMap.t values are not mutable.
<joelr> hcarty: i'm stuffing http headers someplace
philed has quit [Remote host closed the connection]
edwin has joined #ocaml
philed has joined #ocaml
DimitryKakadu has quit [Remote host closed the connection]
DimitryKakadu has joined #ocaml
edwin has quit [Ping timeout: 240 seconds]
<jld> thelema: Right, but the header word is 2 bits for the GC, 8 bits for the tag, and the rest for the length. If I recall correctly. And I think the GC color bits are on the low end. So if you have a header word in the middle of an object, which is what I thought you were getting at....
<philed> rproust: I haven't really been able to use the syntax extensions in Ocaml, since I work mostly with HOL Light which uses camlp5 pervasively. Do I need syntax extensions to ge the >>= and >> syntax for monads?
Asmadeus has quit [Read error: Operation timed out]
Asmadeus_ has joined #ocaml
<rproust> philed: no
<rproust> philed: and yes
joewilliams_away is now known as joewilliams
<rproust> philed: you can use >>= but not >>
<thelema> jld: yes, having an extra header word in the middle of an object might allow that record to be collected while that subrecord lives
<thelema> jld: that said, maybe it suffices to compose the fields once at compile time to get the composite record and just use the composite record
<rproust> philed: >>= is just defined as an infix operator, but >> can't be define that way because of strictness (you must protect the right hand side with a lambda)
<thelema> joelr: probably a stringmap is fine, although only profiling will tell for sure for your app.
<joelr> right
<philed> rproust: Sorry. My search abilities are failing me here. Do you define (>>=) yourself, or is their a library available?
<rproust> you do "let (>>=) = Lwt.(>>=)" if you don't want to "open Lwt"
<rproust> you can also do "let (>|=) = Lwt.(>|=)" to have this operator aavailable
<rproust> if you don't want to open the whole Lwt module, you can have a small module with just >>=, >|=, return, try_bind and the few you want to have and then open this module in every .ml files of your project
<rproust> (assuming it's a multi-file project)
<philed> Ah I see. Simple enough. I'd been told, however, by various people that proper Haskell-like monad libraries were possible in Ocaml via functors, so I assumed that the derived definition of >>= would be provided that way.
<rproust> philed: monad composition can be acheived by functors, if you don't need monad composition you're good with simple opens
robinnn has quit [Remote host closed the connection]
edwin has joined #ocaml
<philed> I'm thinking about generic definitions of things like mapM, foldM, sequence and so on, generalised over arbitrary monads. That's possible right?
<rproust> Lwt also provide state and exception
<rproust> philed: yes, via functors indeed
<orbitz> Is there a way so tha tin debugging mode I can say to export every function?
<orbitz> i want to bring a function up in repl an dplay wiht it a bit to make sure it does what I want
<thelema> orbitz: debugging mode?
<philed> rproust: Ah good stuff. Cheers for your help!
<rproust> orbitz: camlp4 extension pa_macro may help you
<rproust> philed: np, have fun with lwt
<orbitz> thelema: In Erlang i can compile with debug mode that exports all functions in a module
<thelema> orbitz: to export every function in a module, don't use a .mli or signature
<orbitz> I know, but i was wonderinf if there was a way to tell ocamlc to do that for me anyways instead of playing with the .mli
<orbitz> i know i can do thi smanually, my question is simply can i do this automatically
<thelema> rename s/.mli/.mli.disabled/ *.mli
<thelema> rename 's/.mli/.mli.disabled/' *.mli
<orbitz> so no :)
<thelema> correct, there's nothing builtin to do this
<orbitz> ok
Tobu_ has joined #ocaml
Tobu has quit [Read error: Connection reset by peer]
Cyanure has quit [Ping timeout: 276 seconds]
olauzon has joined #ocaml
emmanuelux has joined #ocaml
DimitryKakadu has quit [Remote host closed the connection]
avsm has joined #ocaml
edwin1 has joined #ocaml
edwin has quit [Disconnected by services]
<scooty-puff> i know this may be a sore spot for a lot of people, but:
<scooty-puff> i was just wanting to print something out to debug, without have to iterate, etc.
<scooty-puff> ended up just hooking up a debugger and breaking at the right place
<scooty-puff> i've heard metaocaml can help, but not sure if this is still updated
<scooty-puff> is there another way?
<mrvn> like a pretty printer of any value?
<thelema> scooty-puff: batteries has composable printing functions... List.print (Pair.print String.print Int.print) stdout [("a",3);("b",4)]
<scooty-puff> ok
<scooty-puff> mrvn, yes
<mrvn> thelema: that looks interesting
<mrvn> does it have binary read/write equivalents?
<rproust> there's the deriving syntax extension
<thelema> ? like [Variant.print Foo]?
<mrvn> And how would that look for type t = { x:int; y:float; }?
<rproust> type t = ... deriving (Show) ... let x = ... ... Show.show<t> x
<thelema> mrvn: there's nothing builtin for records or objects, you have to write your own printers for those
<rproust> mrvn: for records deriving works
<thelema> mrvn: or use camlp4, like deriving (as rproust is suggesting)
ankit9 has joined #ocaml
<rproust> List.print (Pair.print String.print Int.print) stdout [("a",3);("b",4)] would be written print_string (Show.show<(string *int) list> [..])
<mrvn> With binary read/write I mean something one can use to transfere data over the network or to another language.
<rproust> deriving Dump
<thelema> mrvn: but if I wanted to print that t, I would do something like: [let print_t oc {x=x;y=y} = fprintf oc "{x=%a; y=%a}" Int.print x Float.print y]
<rproust> it's not human readable, but it can be serialized/deserialized
<thelema> mrvn: use marshal, bin_prot, ext_prot, etc. for serialization - this is for pretty-printing.
<mrvn> That doesn't work if the other language doesn't have the same marshaling module or if the format is predetermined.
<avsm> dyntype has a shelf module that goes to JSON too
Cyanure has joined #ocaml
<rproust> deriving Json in the ocsigen branch
<mrvn> thelema: is there at least a pretty reader? List.scan (Pair.scan String.scan Int.scan) stdin?
<thelema> mrvn: not yet, but you're welcome to write it. It'd be pretty easy, I think.
<thelema> I think the ParserCo library might have 90% of what you'd need
<mrvn> The devil is in the details, those last 5%.
<thelema> sure. one more devil: most composite printers have customizable ~first, ~last and ~sep strings, so it's possible to make output that's not automatically parseable
<mrvn> One only needs a pretty printer that outputs ocaml code. Output that can be cut&pasted into a toplevel and construct the data again.
<thelema> mrvn: the default ones do so (except for data structures that don't have literal formats)
<mrvn> a while back someone suggested they should print a conversion function, like Foo.print would give 'Foo.of_list [1;2;3]'
<thelema> yes, that was me and kaustuv
<mrvn> ahh. :)
<mrvn> and progress there? I really liked the idea.
<thelema> nothing done that I know of. Patches welcome
<mrvn> if only writing patches would pay the bills
<thelema> doesn't pay my bills either - labor of love
<mrvn> which reminds me that I need to get my storage system (MAID) programmed before my old raid runs out of space.
<scooty-puff> on going through one of the tutorials, it looked like you could get a fair bit of information for pretty printing through the c api
<scooty-puff> not exactly pretty
<scooty-puff> but at least exposing
<thelema> scooty-puff: there's implementations of that, for what they're worth. Batteries had Std.dump, which stringifies anything, but it's not pretty
<scooty-puff> ok
<mrvn> scooty-puff: only the memory representation. Which means you have ints, pointer to blocks of int or pointer, floats, int32 and int64.
<scooty-puff> hmm, maybe i should start looking through that more..
<mrvn> No pretty names for variant types or chars and so on.
<thelema> scooty-puff: for example, Std.dump [] = "0"
<scooty-puff> how elucidating, though it does make me feel better - on first looking at the c interface, it looked like an awful lot of info was available at runtime
<mrvn> (a,b) and {a=a; b=b} are also the same memory representation
<thelema> not nearly enough.
<mrvn> scooty-puff: Look at Obj.* All the data is available from ocaml too.
boscop_ has joined #ocaml
<scooty-puff> ok
<hcarty> mrvn: Unless a and b are float, of course
<mrvn> hcarty: float*float is also a float block with 2 entries.
<mrvn> or not?
<hcarty> mrvn: I don't think it is
<mrvn> or was that only for records and arrays?
<thelema> mrvn: I think only records and arrays
<thelema> dunno why not for floats
<thelema> s/floats/tuples/
boscop__ has quit [Ping timeout: 246 seconds]
<mrvn> I guess for records it knows the type and arrays need a range check anyway so the check for float or normal isn't much extra. tuples on the other hand have compile time size so it would cost relatively more to check how to access them.
<thelema> that makes sense
<hcarty> There is no extra runtime cost to check for float records + arrays
<mrvn> match x with (a,b) -> ... would be ugly if it had to check if it is floats first.
<thelema> hcarty: there is for float arrays
<mrvn> hcarty: Array.get arr x needs runtime checks.
<hcarty> I thought the optimization only happened if the record/array was known at compile time to be float only
<thelema> hcarty: true
<mrvn> hcarty: when you construct the array. But how are other functions supposed to know that?
<thelema> hcarty: but a float array can be generated optimized, and passes to a function that takes 'a array
<hcarty> mrvn, thelema: Very true
<mrvn> Which also means that code gets faster when it knows it isn't getting a float array (or that it is).
<mrvn> Sometimes it makes sense to specify a type for 'a array so the compiler knows what it actuall gets.
<mrvn> What I don't really get is why the memory structure doesn't have a type for pointer-less arrays/records.
<mrvn> As in: Here is a block of 1000 ints. You don't need to check each of them for not being a pointer. none of them are.
<thelema> mrvn: when would the compiler check each of them?
<mrvn> thelema: The GC does
<thelema> the GC checks the type of the first element of an array
<thelema> Maybe it doesn't optimize like this for a record with 1K entries
<mrvn> and every element of tuples, records and constructors
<thelema> minimal benefit for the increase in compiler complexity
<mrvn> You are also wrong, for arrays it also checks each of them.
<mrvn> "Arrays of integers and pointers are represented like tuples, that is, as pointers to blocks tagged 0."
<thelema> hmmm...
<thelema> I remember there specifically being a GC optimization for this, but you're right - how would it know the value is an array or a tuple...
<mrvn> It would be trivial for the compiler to use a Int_array_tag for tuples, record and arrays without pointers, when it knows it.
<mrvn> All the code logic should already be there for the float array check.
ulfdoz has joined #ocaml
Snark has quit [Quit: Ex-Chat]
<mrvn> Does anyone have some pull with ocaml upstream? I would really like to get my Int31 patch added to Bigarray.
<thelema> mrvn: bother some of the people on this list: https://github.com/thelema/ocaml-community/commits/origin
<thelema> but I doubt you'll get far, as you're not paying their salary
<thelema> Wow, the stdlib is growing: String.iteri, List.iteri/mapi
<flux> thelema, so it's official now, stdlib is bloatware with a serious case of feature creep?
<thelema> flux: it even has unary positive operators.
<mrvn> http://caml.inria.fr/mantis/view.php?id=4909 in case anyone is interested
edwin has joined #ocaml
<thelema> (~+) and (~+.), which do nothing to ints and floats respectively
<flux> oh.. my.. god!
<thelema> Batteries is missing these!
<hcarty> thelema: Time to shut the project down :-)
<thelema> yup. :)
<thelema> we can't keep up with the rate of changes in the compiler proper
<thelema> yay, structured constants don't prevent inlining anymore! https://github.com/thelema/ocaml-community/commit/b0c5ad955a3d57b5ac6cddabf9a1e4d0bfc973b8
edwin1 has quit [Ping timeout: 276 seconds]
<adrien> thelema: List.iteri? I thought we'd never see these :P
<thelema> there's still a secondary stdlib in the ocaml compiler's ocamlbuild directory. Just for ocamlbuild's use, though.
* thelema has been meaning to steal some of this code for batteries...
<thelema> especially (@:=)
<thelema> err, n/m, I misread what it did. I want to push an item onto a list ref, not concat a list ref with a list
<thelema> err, append a list to a list ref
<mrvn> you don't want to do that, compexity wise.
smerz has joined #ocaml
<scooty-puff> so just a general algorithm question
<scooty-puff> i'm implementing the barnes hut algorithm to try out compiling ocaml to a mobile device
<mrvn> scooty-puff: you've got a browser, right? Run nacl.
<scooty-puff> nacl?
<mrvn> googles browser plugin to run ocaml code.
<scooty-puff> o nice
<mrvn> "The Barnes-Hut simulation (Josh Barnes and Piet Hut ) is an algorithm for performing an n-body simulation ."... that doesn't sound right.
<thelema> mrvn: *that performs -- better?
<thelema> ah, I see what you're unhappy about
<scooty-puff> do what?
<scooty-puff> thats the right one if thats what you mean
<scooty-puff> i've got it working correctly, was just irritated by how i'm strictly computing intermediate nodes on each insert
<mrvn> what has the n-body problem got to do with compiling ocaml for mobile devices?
<scooty-puff> i'm bad at complexity analysis, so wasn't sure if it mattered
<scooty-puff> i can make cool graphics on a phone
<scooty-puff> and gave me a reason to care about performance
<thelema> scooty-puff: okay, what's your algorithm question?
<mrvn> ah, so you just want to run something cool in ocaml on your device. That is a totaly different question. :)
<scooty-puff> each intermediate not of the quad tree i'm having calculated strictly, so the tree is never in an inconsistent state
<scooty-puff> would you expect a significant improvement from calculating only on demand (and caching)?
<thelema> scooty-puff: probably not
<scooty-puff> ok
edwin has quit [Quit: Leaving.]
<mrvn> you could try using Lazy
myu2 has quit [Remote host closed the connection]
<thelema> scooty-puff: are you computing intermediates you're not using?
<thelema> and if your trees are immutable, you probably don't have to worry about inconsistent trees, just keep using the old tree until you've fully constructed the new tree
<scooty-puff> i've heard bad things about lazy, not sure if the info was dated though
<scooty-puff> i assume lazy is implented about how i'd do it though
wagle has quit [Remote host closed the connection]
myu2 has joined #ocaml
<scooty-puff> some of the intermediates may not be used - i.e. Cell(Body, Empty, Empty, Empty, center of mass) + Body -> recomputed center of mass
<scooty-puff> though that would only have to shallowly recompute it..
<scooty-puff> (again, i am really bad at complexity analysis)
<mrvn> you might want to special case cells with only one body and just clone the info from the body.
wagle has joined #ocaml
edwin has joined #ocaml
edwin has left #ocaml []
<scooty-puff> currently its Empty | Body ... | Cell ...
<scooty-puff> and i only have one method to create the tree - of_list, so i can get away with some data sharing/reuse
<philed> rproust: This is a very interesting library. Do you know how it compares to the async stuff in F#?
<orbitz> philed: which library?
ymasory_ has joined #ocaml
<philed> Lwt.
ygrek has joined #ocaml
<orbitz> philed: beyond the surface Lwt doesn't really have async workflows like F# AFAIK
<orbitz> and it can' tmake use of multiple cores
<philed> Ah okay. That means I still need to try out async at some point :)
<orbitz> Lwt is just a concurrency framework, no parallelism
ymasory has quit [Quit: Leaving]
<philed> Sorry again for the questions, but I'm struggling to find help for this on the web. I've never really been able to get camlp4 extensions to work. I'd like to use lwt.syntax, but it's not working for me.
<thelema> philed: how are you compiling?
<philed> I'm working at the interpreter.
<thelema> #use "topfind";; #require "lwt.syntax";;
<thelema> #camlp4o;;
<philed> Yeah, I've tried that. Then when I write "lwt s = Lwt_io.read_line x in s" I just get syntax error on the word "in".
<thelema> maybe that last one before the #require
<thelema> or #require "camlp4"
<thelema> should be the same
<hcarty> thelema: I'm fairly certain the #camlp4o;; does need to come first
<hcarty> Or, rather, second - before the #require
<philed> I've done #camlp4o first.
<thelema> it's kinda disappointing that findlib can't auto-enable camlp4 on requiring a syntax package.
<hcarty> philed: I tried it here and it works
<hcarty> philed: "lwt s = Lwt_io.read_line Lwt_io.stdin;;"
scooty-puff has quit [Ping timeout: 240 seconds]
<philed> Hmm...
<philed> Yeah, I'm getting "Error: Parse error: [str_item] or ";;" expected (in [top_phrase])"
<philed> And it's highlighting stdin as the culprit.
<thelema> philed: try restarting your toplevel and starting from scratch
<hcarty> philed: From a fresh ocaml session, #use "topfind";; #camlp4o;; #require "lwt.simple-top";; #require "lwt.syntax";;
<hcarty> philed: After that it worked for me
<philed> Yeah. I have
<philed> I'll try another machine.
<philed> Oh. It worked.
<philed> Maybe I wasn't bringing in enough modules.
<philed> Hmmm...it seems to be only happen in Emacs.
<philed> With Tuareg mode for me.
enthymeme has joined #ocaml
<philed> Okay folks, thanks for your help. That might well forever be a mystery. Now that I've restarted emacs, everything's fine :/
ymasory_ has quit [Remote host closed the connection]
<philed> hcarty: Ah, I'm being very careless. Yes, the code you gave works. But what if I want to write lwt s = Lwt_io.read_line Lwt_io.stdin in s;;?
myu2 has quit [Remote host closed the connection]
_andre has quit [Quit: leaving]
<hcarty> philed: I'm not sure - that doesn't work for me here either
<philed> hcarty: It doesn't work for me when compiling either.
<hcarty> philed: It could be a bug. I'm not an Lwt expert, but upstream is generally very responsive to feedback
<hcarty> It is probably worth sending them an email to ask what is missing
<philed> Cool, will do. Cheers.
Yoric has quit [Quit: Yoric]
sepp2k has quit [Quit: Leaving.]
enthymeme has quit [Ping timeout: 240 seconds]
ygrek has quit [Ping timeout: 246 seconds]
Fullma has quit [Ping timeout: 246 seconds]
mfp has quit [Ping timeout: 246 seconds]
mfp has joined #ocaml
Fullma has joined #ocaml
ymasory has joined #ocaml
ygrek has joined #ocaml
ymasory has quit [Quit: Leaving]
ymasory has joined #ocaml
ulfdoz has quit [Ping timeout: 240 seconds]
ymasory has quit [Quit: Leaving]
avsm has quit [Quit: Leaving.]
ygrek has quit [Remote host closed the connection]
ygrek has joined #ocaml
enthymeme has joined #ocaml
ikaros has quit [Quit: Leave the magic to Houdini]
adlsaks has joined #ocaml
scooty-puff has joined #ocaml
Cyanure has quit [Ping timeout: 246 seconds]
groovy2shoes has joined #ocaml
lopex has quit [Read error: Connection reset by peer]
joelr has quit [Quit: joelr]
lopex has joined #ocaml
joelr has joined #ocaml
joelr has quit [Client Quit]
Yoric has joined #ocaml
scooty-puff has quit [Quit: Leaving]
ygrek has quit [Ping timeout: 246 seconds]
boscop__ has joined #ocaml
boscop_ has quit [Ping timeout: 246 seconds]
boscop_ has joined #ocaml
boscop__ has quit [Ping timeout: 240 seconds]
ymasory has joined #ocaml
adlsaks has quit [Ping timeout: 246 seconds]
Yoric has quit [Quit: Yoric]
enthymeme has quit [Quit: rcirc on GNU Emacs 23.1.1]
boscop_ has quit [Ping timeout: 246 seconds]
boscop_ has joined #ocaml
boscop_ has quit [Ping timeout: 246 seconds]
Amorphous has quit [Ping timeout: 248 seconds]
enthymeme has joined #ocaml
Amorphous has joined #ocaml
olauzon has quit [Quit: olauzon]
groovy2shoes has quit [Quit: groovy2shoes]
mfp has quit [Ping timeout: 246 seconds]