flux changed the topic of #ocaml to: Discussions about the OCaml programming language | http://www.ocaml.org | OCaml MOOC http://1149.fr/ocaml-mooc | OCaml 4.03.0 announced http://ocaml.org/releases/4.03.html | Try OCaml in your browser: http://try.ocamlpro.com | Public channel logs at http://irclog.whitequark.org/ocaml
nicholasf has quit [Ping timeout: 272 seconds]
demonimin has quit [Ping timeout: 276 seconds]
nicholasf has joined #ocaml
demonimin has joined #ocaml
demonimin has quit [Changing host]
demonimin has joined #ocaml
silver has quit [Quit: rakede]
darkf has joined #ocaml
pyon has quit [Quit: ... flowering silent scarlet piece of night.]
wtetzner has joined #ocaml
Algebr` has joined #ocaml
pyon has joined #ocaml
dakk has joined #ocaml
<cheater> hi
<aantron> cheater: heya
<cheater> i am trying to use functions described here: https://ocaml.janestreet.com/ocaml-core/109.12.00/doc/core/Unix.html so in my code I wrote: Core.Unix.system("echo system system system"). ocaml tells me "Core.Unix" is unbound. I used to compile my program using corebuild -j 4 -pkg async,textutils foo.native and now I added unix to the list of packages but that seems wrong. what am i missing?
<aantron> not sure exactly how core works, but im guessing the unix package is for the ocaml standard library module
<aantron> corebuild* works
<cheater> how do i find out what the right package here is?
<cheater> this documentation has gaping holes :S
FreeBirdLjj has joined #ocaml
<aantron> hmmm try adding just package "core"
<aantron> what i did was look at "ocamlfind list | grep unix" and "ocamlfind list | grep core" for a switch that im pretty sure has Core.Unix installed. but not fully sure as im not a direct user
<cheater> :S
<aantron> im guessing async depends only on core_kernel and im guessing that doesnt pull in core.unix
<cheater> nope, core didn't fix it
<aantron> hm ok
<cheater> is there really no standard way to find out what packages a module is in??
<cheater> this is super disappointing
<cheater> :(
<aantron> none that i am aware of. typically the library docs make it clear, but for a complex distribution like core, it might not be so clear
<aantron> however ocp-browser loads names and docs from all your installed packages
<aantron> so clearly its possible, probably using findlib and compiler-libs together
<aantron> maybe people using merlin or those with more experience with ocp-browser and similar tools can comment
<aantron> hmm
<aantron> have you tried looking in a more recent version of the docs?
<cheater> ok, opam list helped
<cheater> so the right module name is just Unix, not Core.Unix
<aantron> ah yes, in that case yes, you use package unix. its the stdlib
<aantron> anyway, enjoy. have to run
<struk|desk> cheater: opam and ocamlfind should definitely have you covered
<cheater> hmm nope aantron, look at the link, it's from core
<cheater> struk|desk: thanks :)
<cheater> aantron: thank you!
<cheater> ok, i have another question... on the link i posted, it says the following:
<cheater> val system : string -> Exit_or_signal.t
<cheater> but ocaml tells me this:
<cheater> This expression has type Async.Std.Unix.Exit_or_signal.t Deferred.t
<cheater> what's going on?
<cheater> hmm
<struk|desk> did you open Async.Std ?
<struk|desk> that would make it appear like that
<cheater> oh yeah
<struk|desk> it means that the unix module is wrapped in a deferred monad
<struk|desk> if you don't need async, just open Core.Std
<cheater> i need async
<cheater> but i also need the non-async Unix module
<struk|desk> Core.Std.Unix.system
<cheater> let me try that thanks
<struk|desk> you can do module CoreUnix = Core.Std.Unix
<cheater> thanks. going from the link above, how would i know that I had to use "Core.Std.Unix" in my code?
<struk|desk> because its in the "core" module
<struk|desk> Core.Std and Async.Std are just conveniences to open the modules and give them reasonable names like ocaml std lib
<cheater> i don't get it sorry
<struk|desk> all I am trying to see is, internall jane street gives the implementations weird names
<struk|desk> like Core_kernel rather than core
<struk|desk> and unix probaby is nested somewhere in that mess
<struk|desk> but they provide a module called "Std" which renames them and opens them to something natural
<cheater> so basically the only option is "come here and ask until you've learnt it all by heart"?
FreeBirdLjj has quit [Remote host closed the connection]
FreeBirdLjj has joined #ocaml
<struk|desk> well the first thing they tell you is to open Core.Std
<struk|desk> lol
<struk|desk> anyhow look at this. the code never lies: https://github.com/janestreet/core/blob/master/src/std.ml
<struk|desk> I think the docs are obfuscating you a bit
<struk|desk> see line 37 ?
<cheater> haha
<cheater> one sec
<cheater> yea
<cheater> i understand the concept of mess you are telling me about
<cheater> i dread it
<struk|desk> there is good reason to prefix things with core_* though. so it doesn't mangle the names with std lib versions
<cheater> right
<cheater> so it's opt in
<struk|desk> correct
<cheater> for when you're eg refactoring from one to the other
<cheater> btw, do you know a bit about async?
<struk|desk> sure
<cheater> i'm kind of trying to figure something out here
<struk|desk> I need to eat some dinner, give me a few minutes. ask away though
<cheater> so i have this protocol set up using Rpc.Rpc.create and Rpc.Rpc.implement
<cheater> and i have a client and server path in my program and the client can connect to the server's port, do an rpc, and get a result
<cheater> but now i'd like the server to be able to send to the client at will as well, how do i do that?
FreeBirdLjj has quit [Remote host closed the connection]
FreeBirdLjj has joined #ocaml
<struk|desk> haven't used rpc module, but ifs it like any rpc system. its not really bidirectional. you would need a connection established on both ends
<struk|desk> also "at will" is what exactly? can you just use a something like pipe ?
<struk|desk> cheater: there is also zeromq or nanomsg to consider for this type of stuff, both of which have ocaml implementations. zero mq is nice in that it is superfast and has both pub/sub and req/resp (eg. rpc). might be overkill for u though
<cheater> i don't know what you mean by "pipe". i would like the server to talk to the client when it wants
<struk|desk> yeah but that sounds a bit half baked
<cheater> i can't set up an external queue or anything like that, i would like this to be self contained
<struk|desk> hence why the web has websockets, long polling, and a billion other things these days to do this
<struk|desk> if you just want server to talk to client
<cheater> yes, that's the kind of thing i want
<struk|desk> set up 2 rpc connetions
<cheater> is there something like this in async?
<struk|desk> um, like I said, just establish an rpc connection from the server to the client, and the client to the server
<cheater> or maybe i should just have an async call from the client which always hangs around and only returns when there's a new thing that the server wants to give it?
<struk|desk> pipes are good use case if you want the server to push "events to the client
<cheater> i don't know if i can establish a connection from the server to the client, the client might be behind a router
<cheater> NATed
<struk|desk> then probably want a pipe I guess? server pushes onto pipe, client pulls
<cheater> what's a pipe?
<struk|desk> its just a queue over sockets, written in async style
<struk|desk> like Pipe.read Pipe.write etc.
<struk|desk> *look at
<struk|desk> but honestly I don't find async enough for interprocess communication, myself. its more like a stepping stone
<struk|desk> yeah
<cheater> thanks, i'll check it out
<cheater> i may have been incorrect to use Rpc after all
<struk|desk> it usually is :) unless you have a really simple architecture
<cheater> mhm
<cheater> thanks a lot!
<cheater> i'll try using pipe then
<struk|desk> there is also async parallel but the documentation is not great and I couldn't get it to work in any true distributed use case
<struk|desk> np
<cheater> oh
<cheater> ok
<struk|desk> if you get desperate, consider using a middleware that is built on async to do this. good luck!
demonimin has quit [Remote host closed the connection]
demonimin has joined #ocaml
<struk|desk> hmm yeah not sure the pipe will serve you for IPC purposes. you probably need something from unix module
pierpa has quit [Ping timeout: 264 seconds]
FreeBirdLjj has quit [Remote host closed the connection]
FreeBirdLjj has joined #ocaml
<cheater> struk|desk: i need to be able to pass messages from client to server and from server to client
<cheater> i think pipe is the right thing actually, rather than rpc
FreeBirdLjj has quit [Remote host closed the connection]
FreeBirdLjj has joined #ocaml
groovy2shoes has joined #ocaml
ygrek has quit [Ping timeout: 258 seconds]
basis has joined #ocaml
FreeBirdLjj has quit [Remote host closed the connection]
FreeBirdLjj has joined #ocaml
shinnya has quit [Ping timeout: 264 seconds]
Algebr` has quit [Ping timeout: 250 seconds]
A1977494 has joined #ocaml
FreeBirdLjj has quit [Remote host closed the connection]
FreeBirdLjj has joined #ocaml
rgrinberg has joined #ocaml
rgrinberg has quit [Ping timeout: 244 seconds]
wtetzner has quit [Remote host closed the connection]
<struk|desk> cheater: yeah but I don't think pipes are interprocess...they are just interthread
FreeBirdLjj has quit [Remote host closed the connection]
FreeBirdLjj has joined #ocaml
darkf_ has joined #ocaml
darkf has quit [Disconnected by services]
darkf_ is now known as darkf
MercurialAlchemi has joined #ocaml
wtetzner has joined #ocaml
AlexDenisov has joined #ocaml
wtetzner has quit [Ping timeout: 276 seconds]
AlexDeni_ has quit [Ping timeout: 250 seconds]
jonasen has joined #ocaml
jonasen has quit [Quit: My Mac has gone to sleep. ZZZzzz…]
sdothum has quit [Quit: ZNC - 1.6.0 - http://znc.in]
MercurialAlchemi has quit [Ping timeout: 250 seconds]
<cheater> struk|desk: i'm looking for network
<cheater> ok, i'm sticking to rpc and long-polling then
<cheater> struk|desk: i need this to work over the network
FreeBirdLjj has quit [Ping timeout: 260 seconds]
FreeBirdLjj has joined #ocaml
groovy2shoes has quit [Remote host closed the connection]
groovy2shoes has joined #ocaml
FreeBird_ has joined #ocaml
nicholasf has quit []
FreeBirdLjj has quit [Read error: Connection reset by peer]
darkf_ has joined #ocaml
darkf has quit [Ping timeout: 250 seconds]
<struk|desk> cheater: ok, got ya
struk|desk has quit [Read error: Connection reset by peer]
struk|desk has joined #ocaml
darkf_ is now known as darkf
copy` has quit [Quit: Connection closed for inactivity]
jonasen has joined #ocaml
MercurialAlchemi has joined #ocaml
<cheater> ok struk|desk so apparently Tcp.Server.create takes a function that takes a reader and a writer so you could also use a pipe there
<cheater> but like
<cheater> i don't think that's what we wanted from pipes anyways
spion_ has quit [Ping timeout: 240 seconds]
spion has joined #ocaml
tane has joined #ocaml
FreeBird_ has quit [Remote host closed the connection]
FreeBirdLjj has joined #ocaml
<struk|desk> cheater: what do you expect from a pipe then?
al-maisan has quit [Quit: See you later..]
larhat has quit [Quit: Leaving.]
freusque has joined #ocaml
FreeBirdLjj has quit [Remote host closed the connection]
FreeBirdLjj has joined #ocaml
Simn has joined #ocaml
FreeBirdLjj has quit [Remote host closed the connection]
FreeBirdLjj has joined #ocaml
FreeBirdLjj has quit [Remote host closed the connection]
FreeBirdLjj has joined #ocaml
AlexDenisov has quit [Quit: My Mac has gone to sleep. ZZZzzz…]
FreeBirdLjj has quit [Remote host closed the connection]
FreeBirdLjj has joined #ocaml
obj_magic has quit [Ping timeout: 240 seconds]
lopex has quit [Read error: Connection reset by peer]
lopex has joined #ocaml
tizoc has quit [Ping timeout: 240 seconds]
seangrove has joined #ocaml
riveter has quit [Quit: ZNC - http://znc.in]
riveter has joined #ocaml
obj_magic has joined #ocaml
nojb_ has joined #ocaml
<seangrove> Has anyone got OpenGL working via https://github.com/dbuenzli/tgls ?
tizoc has joined #ocaml
<seangrove> Also, if I want to provide a module that implements some rendering functions for other modules to use, but itself conditionally pulls in tgls or compiles to webgl, what does that project setup look like?
FreeBirdLjj has quit [Remote host closed the connection]
FreeBirdLjj has joined #ocaml
FreeBirdLjj has quit [Remote host closed the connection]
FreeBirdLjj has joined #ocaml
dexterph has joined #ocaml
freusque has quit [Ping timeout: 272 seconds]
basis has quit [Quit: basis]
AltGr has joined #ocaml
FreeBirdLjj has quit [Remote host closed the connection]
basis has joined #ocaml
FreeBirdLjj has joined #ocaml
<edwin> seangrove: I used tgls a while ago and it worked fine, I tried converting some of the opengl programs from this tutorial http://web.archive.org/web/20150309070928/http://www.arcsynthesis.org/gltut/
<edwin> I only used it with OpenGL, didn't try webgl
seangrove has quit [Ping timeout: 252 seconds]
Kakadu has joined #ocaml
FreeBirdLjj has quit [Remote host closed the connection]
FreeBirdLjj has joined #ocaml
dexterph has quit [Remote host closed the connection]
dexterph has joined #ocaml
larhat has joined #ocaml
freusque has joined #ocaml
larhat has quit [Read error: Connection reset by peer]
emias has quit [Ping timeout: 246 seconds]
emias has joined #ocaml
jonasen has quit [Ping timeout: 264 seconds]
jwatzman|work has joined #ocaml
MercurialAlchemi has quit [Remote host closed the connection]
MercurialAlchemi has joined #ocaml
jwatzman|work has quit [Quit: jwatzman|work]
jwatzman|work has joined #ocaml
AlexDenisov has joined #ocaml
jonasen has joined #ocaml
emias has quit [Ping timeout: 258 seconds]
emias has joined #ocaml
basis has quit [Quit: basis]
<struk|desk> anyone know how to get rid of this error? Am lost on how I get the record fields to be public here: https://gist.github.com/struktured/8faab2d568f2c7916d7ffd49b9419d2f and https://github.com/struktured/ocaml-omkl/blob/master/src/omkl_kernels.ml#L80
rossberg_ has quit [Ping timeout: 264 seconds]
tane has quit [Quit: Leaving]
<tormen> In module List there is "map"+"mapi" "iter"+"iteri" "rev_map"... but no "rev_mapi" :(
<tormen> (any particular reason ?)
<struk|desk> yeah, ocaml std lib is missing a ton of useful stuff :)
silver has joined #ocaml
<struk|desk> tormen: jane street's core has it though.
<mrvn> tormen: file an issue please
dave24 has joined #ocaml
<tormen> mrvn: where?
rossberg_ has joined #ocaml
<mrvn> tormen: that or mantis
manizzle has quit [Ping timeout: 244 seconds]
<mrvn> github is nicer if you want to send a patch for it
<tormen> mrvn: thanks!
<mrvn> Just noticed ocaml has no issue tracker on github, only pull requests. So just for patches there.
<tormen> mrvn: ... yeah... just saw that too ;)
<tormen> but with http://caml.inria.fr/bin/caml-bugs that makes sense I guess...
AlexDenisov has quit [Quit: My Mac has gone to sleep. ZZZzzz…]
<mrvn> totaly.
<mrvn> also model&view has ItemIsCheckable
<mrvn> ups
FreeBirdLjj has quit [Remote host closed the connection]
FreeBirdLjj has joined #ocaml
manizzle has joined #ocaml
<tormen> mrvn: hmmm does the List Module count as "Ocaml standard library" or does the standard library only entail "Pervasives" ?
<tormen> okey just saw the struk|desk comment ;)
<tormen> mrvn: Thanks !
regnat[m] has quit [Remote host closed the connection]
M-pesterhazy has quit [Read error: Connection reset by peer]
M-jimt has quit [Remote host closed the connection]
M-martinklepsch has quit [Write error: Connection reset by peer]
M-Illandan has quit [Read error: Connection reset by peer]
sdothum has joined #ocaml
manizzle has quit [Ping timeout: 244 seconds]
jwatzman|work has quit [Ping timeout: 250 seconds]
AlexDenisov has joined #ocaml
dhil has joined #ocaml
silver_ has joined #ocaml
rand__ has joined #ocaml
silver is now known as Guest34788
silver_ is now known as silver
Guest34788 has quit [Ping timeout: 264 seconds]
regnat[m] has joined #ocaml
AlexDenisov has quit [Quit: My Mac has gone to sleep. ZZZzzz…]
<mrvn> Has anyone used phantom types that can not escape their scope?
<mrvn> I want to create a buffer that has a phantom type [<`Read | `Write]. But I want to create a `Write buffer, fill it and then return it as `Read without the potential of e.g. storing the `Write buffer in a global ref or something where it escapes its scope.
<mrvn> kind of a poor mans linear type
<Drup> "without the potential of e.g. storing the `Write buffer in a global ref or something where it escapes its scope." <- do you really want to forbid that, or just make it inconvenient ?
FreeBirdLjj has quit [Remote host closed the connection]
FreeBirdLjj has joined #ocaml
<mrvn> Drup: well, I want `Read | `Write | `Write_for_now_but_soon_read
<mrvn> The last I want to forbid to escape
<zozozo> I'd say converting the `Write Buffer to a string would do the trick, but maybe not what you want
<mrvn> zozozo: that would copy and is not what I want
<Drup> is something like "fill_buffer : ( [`Write] buffer -> unit ) -> [`Read] buffer" satisfying ?
<Drup> it doesn't formally prevent stuff, but you need to go out of your way to screw it up
<mrvn> Drup: nope, that could store the write buffer in a global ref
<Drup> right
<Drup> (I'm of the opinion this is sufficient and if your users spend some amount of effort walking around your API, they will do it no matter what. You should know that, given your tendency to use Obj.magic :p)
<mrvn> Drup: but that's basically what I have now.
<Drup> you can do better, with GADts.
<mrvn> tell me more
<mrvn> brb, phone
<Drup> type any_buffer = Any : _ buffer -> any_buffer
<Drup> then fill_buffer : ( any_buffer -> ... ) -> ..
<Drup> it prevents storing it in a ref
M-martinklepsch has joined #ocaml
M-jimt has joined #ocaml
M-pesterhazy has joined #ocaml
M-Illandan has joined #ocaml
<Drup> (iirc, you can still walk around that one, but I don't remember how right now)
sfri has quit [Remote host closed the connection]
<mrvn> re
<mrvn> Drup: how do I then call e.g. Buffer.set with the any_buffer in the init code?
<Drup> you unpack the existential
jwatzman|work has joined #ocaml
<Drup> you can still it while it's packed
<Drup> leak it packed, unfortunatly
<mrvn> when I unpack it I get an _ Buffer while set needs a `Write Buffer
<Drup> blerg, the trivial solution is better >_>
<mrvn> Drup: that's what i wanted. thx
<mrvn> Drup: only ... better would be to hide the gadt in the phantom type
unbalancedparen has joined #ocaml
<Drup> you need the user to unpack the existential, to create the type variable
<Drup> mrvn: it's still doesn't actually work you know, you can still go out of your way to leak it
<mrvn> ack
<mrvn> it's more about accidentally leaking it
<mrvn> nothing is safe from Obj.magic
<Drup> mrvn: have you actually seen a user accideintally leaking the buffer with the simpler version ?
<mrvn> not yet
<Drup> ok, so you are over engineering it a lot.
<mrvn> just playing with ideas
sfri has joined #ocaml
freusque has quit [Quit: WeeChat 1.4]
AlexDenisov has joined #ocaml
Nahra has quit [Remote host closed the connection]
tane has joined #ocaml
FreeBirdLjj has quit [Remote host closed the connection]
sepp2k has joined #ocaml
FreeBirdLjj has joined #ocaml
AlexDenisov has quit [Quit: My Mac has gone to sleep. ZZZzzz…]
<Kakadu> Folks, does merlin use json-like messages for some editors instead of sexp ones?
<Kakadu> I'm kind of tryin to understand what should I send to merlin to get something useful.
FreeBirdLjj has quit [Remote host closed the connection]
FreeBirdLjj has joined #ocaml
<def`> Kakadu: json & sexp, what do you want to do ?
<Kakadu> def`: I'm trying to understand how to communicate with it
<Kakadu> and I have running emacs and strace on merlin
<Kakadu> It will be great to have some editor which uses JSON based messages (emacs uses sexp-based)
troydm has quit [Ping timeout: 244 seconds]
<Kakadu> So, does any editor use JSON to communicate with merlin?
<Kakadu> Also I think that I seen some initial communication between emacs and merlin
<Kakadu> (I don't know how btw)
<Kakadu> It seems that straces exits when I do M-x merlin-restart-process
<def`> yes, measuring current drawn proved to be more reliable
<cheater> hi
<cheater> does ocaml have something like haskell's $?
<def`> cheater: @@
FreeBirdLjj has quit [Remote host closed the connection]
<cheater> ok so if i have:
<cheater> foo bar baz (fun quux ->
<cheater> bla bla bla)
<cheater> i could do foo bar baz @@ fun quux ->
<cheater> bla bla bla
<cheater> ?
<def`> yes
<cheater> thank you
FreeBirdLjj has joined #ocaml
<Kakadu> def`: It is very useful, thanks
<def`> Kakadu: you are welcome, I can answer questions, but expect delays (GMT+8)
<tormen> mrvn: Any reason there is no "exp" function for int, int32, int64 ? (like in : exp 10 3 = 1_000)
<tormen> (only found one for float)
<gasche> def`: Hong Kong?
<rks`_> Nagoya
<gasche> eh :-)
<gasche> the website I looked at thinks Japan is GMT+9
agarwal1975 has joined #ocaml
<gasche> tormen: no specific reason to my knowledge
<gasche> I would expect extended standard libraries to have them (Batteries does)
<gasche> also, are you sending a patch for rev_mapi?
<def`> gasche: correct, it's +9 :)
<tormen> gasche: ok, thanks. Should this be standard ? About rev_mapi: For now I did not plan to ... bad ?
<gasche> I think "rev_mapi" is a rather obvious addition, plus it's dead easy to implement, so I would go for it if I were you
<gasche> I'm a bit less convinced about "exp" (for example people may argue that you actually want (exp : t -> int -> t) most of the time or whatever)
rgrinberg has joined #ocaml
A1977494 has quit [Remote host closed the connection]
<mrvn> tormen: double exp(double x);
<mrvn> float expf(float x);
<mrvn> long double expl(long double x);
<mrvn> tormen: no such thing for int in C. (my guess why there isn't in ocaml)
<tormen> mrvn: ha. good point. still would like it, especially as there is int, Int64 and Int32 with different syntax.
<mrvn> The input range of exp for int is also verry limited.
<tormen> mrvn: hmm yes.
<tormen> mrvn: ... yeah ok maybe it's better like it is ;)
<mrvn> let rec (**) ?(acc=1) x = function 0 -> 1 | 1 -> acc * x | n -> x ** ~acc:(acc * x) (n - 1) ?
<def`> come on, fast exp plz
<companion_cube> ^^
<gasche> (that's super-old code; and I see now that it should also parametrize over equality...)
<companion_cube> it might be better if functorized, I think
<def`> gasche: any interest in having n something different than int ?
<companion_cube> if modular implicits land, they will really induce huge chances in how we write stdlibs...
<mrvn> companion_cube: http://paste.debian.net/776668/
<def`> I can see why you want to abstract over a semiring for whatever is exponentiated, but for the exponent itself :P
<gasche> I agree
<mrvn> def`: int64 ** int64
<def`> mrvn: yes?
<mrvn> def`: no need to Int64.to_int the second arg
<gasche> calling "to_int" is likely to be faster and I think semantically it makes more sense
<def`> :-)
<mrvn> or bigint ** int64, maybe you want to compute 2 ** 372536887777575685LL
<companion_cube> when computing exponentation, I don't see how int could be limiting
<gasche> the power operation is raising a monoid element to a natural power
<companion_cube> mrvn: buy some ram beforehand
<gasche> so either infinite-precision integer or "whatever approximates them usually in your language" make more sense
<mrvn> companion_cube: 2^0x100000000 only need 1GB ram.
<mrvn> half even
<companion_cube> ah, right, you can divide by 8
<def`> yes, and "1" ^ 0x1000000000000000000 easily fits in ram with an appropriate rope implementation
<mrvn> def`: one that reuses equal substrings?
<gasche> this discussion is a waste of time :] (any correlation with stdlib?)
<mrvn> def`: or one that stores a^a as such instead of copying?
<companion_cube> then use bigint as an exponent :)
<def`> gasche: you are welcome :D
<companion_cube> fun fact: I have somewhere a multiset where elements' multiplicity range over Z.t
<mrvn> gasche: any more thoughts on int_least31? Is it mood now because int32 bigarrays get unboxed properly everywhere?
<def`> companion_cube: is that useful :P ?
<companion_cube> yes, it was useful
<gasche> mrvn: no additional thought from myself
<companion_cube> (mostly because I use it to represent n·t as the multiset {t,t,...} n times)
<companion_cube> (and then I use the multiset ordering to compare such multisets)
<gasche> I think you have to convince Alain that it makes performance sense to have int_least31, or recognize that it's unnecessary today
<def`> that doesn't explain why you need negative multiplicities?
<companion_cube> ah, I don't, sorry
<gasche> (personally I think that having something that specifies an efficiency profile without relying on optimizations is useful)
<companion_cube> there is no N.t in zarith, is there?
<def`> :) ok
<mrvn> gasche: any idea why int_least31 does a c_call?
<mrvn> gasche: because as is it is actually slower than int32
<gasche> maybe the default access is a C call and the compiler optimizes it away on known type, and your addition doesn't extend that
<gasche> but no specific idea, no
<cheater> hi
<cheater> on the end of my module i have let () = if not !Sys.interactive then begin main end, but if inside utop i do #use my_module.ml then main gets executed anyways. why is that?
<cheater> i wouldn't like this to get executed if i am inside utop
<companion_cube> if main:unit, it's already executed
<cheater> should i rename it to something else?
<companion_cube> no, you might want `main : unit -> unit` to delay evaluation
<cheater> nah that hasn't worked
<cheater> yeah ok
<cheater> let me do that thanks :)
<cheater> why does it get evaluated immediately?
<cheater> do all let's that are of type unit get evaluated on compile time?
<companion_cube> the toplevel ones, yes
<companion_cube> `let () = ....` at toplevel is how you write entry points/initialization code
AlexDenisov has joined #ocaml
<cheater> thank you
AlexDenisov has quit [Client Quit]
<struk|desk> anyone know how to get rid of this error? Am lost on how I get the record fields to be public here: https://gist.github.com/struktured/8faab2d568f2c7916d7ffd49b9419d2f and https://github.com/struktured/ocaml-omkl/blob/master/src/omkl_kernels.ml#L80
<cheater> hmm...
<cheater> why doesn't core's Monad have >> ?
<Drup> >> is not implementable properly for a lot of monads in a strict language like OCaml.
Sorella has quit [Quit: Connection closed for inactivity]
<Drup> if you do "foo >> bar" foo and bar are both evaluated before the call to >>, which doesn't really follow the intended semantics. It works in haskell because it's call by need
<cheater> ok so that's why i have to put bar in a lambda?
<Drup> yes
<cheater> thank you
<cheater> that makes sense
troydm has joined #ocaml
FreeBirdLjj has quit [Remote host closed the connection]
<cheater> i have another question. in async i have a loop that keeps on spawning defereds. it looks like this: http://sprunge.us/XZDI
<cheater> now i would have to have a second loop that keeps on polling some other stuff. how do i spawn both?
FreeBirdLjj has joined #ocaml
<Drup> just call both functions and use join (not sure of the name in Async, it's of type 'a list t -> 'a t)
<Drup> unit*
FreeBirdLjj has quit [Ping timeout: 260 seconds]
<gasche> hm Drup
<gasche> I thought monads were more independent of evaluation order than that
<gasche> do you have an example of a problematic (bar >> foo)?
<Drup> gasche: async, lwt
<companion_cube> well, Lwt
<gasche> (I mean in a proper design where evaluation a ('a t) is pure)
<gasche> ah
<companion_cube> since evaluating a future starts some IO
<gasche> yeah, it's not a proper monad
<gasche> but I guess that's fine
<Drup> gasche: it follows the monad laws :|
<Drup> as a general rule, x >> y ≡ x >>= fun () -> y, which works in haskell but not in OCaml, it's not really about not being a proper monad
<gasche> well
<gasche> the point of a monadic meta-language is that evaluation in the language is pure, it is the monadic operations that perform the effects
<gasche> that's what we assume when we say that monads provide "effects tracked through types"
<gasche> but I guess it's too late to come back on that debatable design choice of Lwt
<Drup> gasche: except that computation is not an effect.
<gasche> hm
jonasen has quit [Quit: My Mac has gone to sleep. ZZZzzz…]
AlexDenisov has joined #ocaml
AlexDenisov has quit [Client Quit]
<gasche> you said earlier than (>>) is not implementable properly for many monads. If (>>) for Lwt is improper, it's because when computations are run are part of the observable properties of the code that we consider when reasoning about it. Or, alternatively, you claim that efficiency is not part of the specification, and then (>>) is properly implementable for Lwt
<companion_cube> Drup: I'm not sure it does satisfy the monad laws
<gasche> for many monads (list, option, state, whatever) there is a reasonable (>>) implementation where eager evaluation of the right-hand side is not an issue
<gasche> because the particular effect we are reasoning about is not part of this right-hand-side evaluation
<Drup> I didn't say efficiency is not part of the specification, I said that computation is not an effect according to your point about monadic operations. which makes the decision about the implementability of >> orthogonal
<gasche> I don't think this is related to call-by-value vs. call-by-need
<mrvn> if there are no side effects then wether you compute or not is irelevant.
<companion_cube> but lwt is full of side effects
<companion_cube> which are outside the monad part
<Drup> sure
<mrvn> which makes it hard to be monadic
<Drup> but even if it was not, >> would still be a bad idea :>
<companion_cube> I mean, `let f = Lwt_io.read_line in Lwt.join [f;f]` and `Lwt.join [read_line (); read_line ()]` are not the same
<gasche> in a call-by-need language you may force monadic values as well, and you would have the same problem if the monad had made the same design choices as Lwt
<gasche> (for example a distribution monad may have a (join : 'a dist dist -> 'a dist) that will force the outer layer)
<Drup> gasche: but by definition of call by need, ">>= fun () ->" is the same as >>, regardless of the definition of >>=
<Drup> the fact that the right hand side is suspended still works
darkf_ has joined #ocaml
freusque has joined #ocaml
darkf__ has joined #ocaml
darkf has quit [Ping timeout: 250 seconds]
darkf_ has quit [Ping timeout: 250 seconds]
AlexDenisov has joined #ocaml
AlexDenisov has quit [Quit: My Mac has gone to sleep. ZZZzzz…]
jonasen has joined #ocaml
MercurialAlchemi has quit [Ping timeout: 258 seconds]
shinnya has joined #ocaml
beginner has joined #ocaml
<beginner> when building menhir from source, how can i set the optimization level to -O3?
<companion_cube> if it's ocamlbuild, you can add the tag optimize(3) in _tags
copy` has joined #ocaml
<beginner> i added "optimize(3)" to the bottom but get a syntax error
<companion_cube> true: optimize(3)
<companion_cube> or something similar
A1977494 has joined #ocaml
AlexDenisov has joined #ocaml
<beginner> companion_cube: thanks, true: optimize(3) works
AlexDenisov has quit [Quit: My Mac has gone to sleep. ZZZzzz…]
AlexDenisov has joined #ocaml
<cheater> Drup: ohh
jeffmo has joined #ocaml
<cheater> Drup: i think you mean all : 'a t list -> 'a list t
<Drup> ah, yes
<Drup> or unit t list -> unit t
<cheater> yes that's all_unit
<cheater> thank you Drup
<cheater> btw, what would i use that's similar to a Haskell MVar?
hcarty has joined #ocaml
<cheater> i want to be able to put a thing in a box and have whatever is reading it block until the box has been filled elsewhere
<cheater> and this has to work with deferreds of course
<hcarty> seliopou: For a somewhat pathological case (lots embedded tiny maps/arrays), your optimization suggestion of sticking all of the msgpack tag bits into a big match/function case was tremendously successful
<cheater> this looks good
<hcarty> seliopou: ~23k encodings per second -> ~122k encodings/second
<hcarty> s/lots/lots of/
<Drup> cheater: isn't that just an Async.t ?
<Drup> (I don't really know Async, I use only Lwt)
<gasche> hcarty: what does the change look like?
MercurialAlchemi has joined #ocaml
<hcarty> gasche: A big match over the first tag byte
<companion_cube> Drup: the MVar can be changed several time, can'it it?
<hcarty> One moment, I'll pastebin it
<gasche> if the bottleneck in your parser is matching header tags, the parsing library is doing a good job
<gasche> thanks
<hcarty> As I said last week, I'm quite happy with angstrom
<gasche> I wondered if that was related to the string-matching optimization, but it's just a byte here
<hcarty> gasche: It's also eliminating lots of `compose` calls
<gasche> ah
<Drup> the string matching optim was a few ocaml version ago, right ?
<gasche> yes
<gasche> 4.02.0
<gasche> (August 2014)
<gasche> notice how 4.02.0 feels like long ago?
<Drup> I remember looking at the generated code in awe :3
<gasche> (long ago, and, as a particular .x release, quickly forgotten)
<hcarty> seliopou: Only 322 encodings/second with 10 megabyte blobs on the same system, though :-)
<cheater> is there something like Ivar.fill_if_empty but it'll block until it's not empty?
<gasche> I would try catching Ivar.fill's exception
<gasche> (but the fact that it's not in the API suggests that things are rather done in another way)
<cheater> hmm i am trying to figure out what that way is
<cheater> also, is there a way to make an ivar empty again after it had been filled?
<gasche> I think the fact that IVar are monotonic matters a lot for program reasoning
<gasche> (it makes behavior independent of scheduling choice)
<gasche> (monotonic: they never change once they're set)
<companion_cube> a MVar is closer to a blocking queue with size 1
<gasche> (excellent expositions of this programming model are Oz/Mozart deterministic concurency primitives, then the later LVar research)
<cheater> oh they can only be set once?
<cheater> ok i didn't know that
<cheater> i am probably looking for an MVar then yes
<companion_cube> I mean, MVar in haskell; you can probably write one quite simply with async
<companion_cube> (with Lwt I'd know how to do it: a `'a option ref` + a condition)
pierpa has joined #ocaml
<Drup> companion_cube: "'a Lwt.t ref" ? :3
<companion_cube> I don't think so, you want the MVar to be able to be empty
<cheater> hmm
<cheater> :/
<Drup> ah, right
<companion_cube> (well you can have a `'a Lwt.t ref`, but it needs to be paired with a `'a Lwt.u`)
<companion_cube> 'a Lwt.u ref sorry
<cheater> well either way... how do i use this package? I tried this but it errors out
<cheater> $ corebuild -j 4 -pkg async,textutils,core,core_kernel,async-mvar chat_app.native
<cheater> + ocamlfind ocamldep -package async,textutils,core,core_kernel,async-mvar -package core -ppx 'ppx-jane -as-ppx' -modules chat_app.ml > chat_app.ml.depends
<cheater> ocamlfind: Package `async-mvar' not found
<cheater> Command exited with code 2.
<companion_cube> have you installed async-mvar?
<cheater> hmm no. i have to do that?
<companion_cube> yes! `opam install async-mvar` should do the trick
dakk has quit [Ping timeout: 246 seconds]
<nore> hm, is it known that enclosing caml code in comments sometimes isn't correct?
<nore> what I mean is:
<nore> let ( *) x y = 42 is valid OCaml
<nore> but (* let ( *) x y = 42 *) (followed by something)
<companion_cube> `let ( * ) x y = 42`, otherwise it's not valid
<nore> is a syntax error
<nore> companion_cube: well, it gets a warning 2
<nore> but it works
<companion_cube> oh interesting
<companion_cube> this is terrible
<companion_cube> (good thing the warning is there(
<companion_cube> )
<nore> (I tested only in 4.02.3 though)
slash^ has joined #ocaml
<nore> maybe this has been fixed since then, but I doubt it
bruce_r has joined #ocaml
<nore> oh, and I tested both in the interpreter and in a file, same behaviour
<nore> should I open an issue for this, or is it too trivial?
<companion_cube> I think the warning probably comes from the problem you're describing
<nore> it probably does
<nore> but still, I though any caml code was supposed to be able to be commented out by a simple comment pair
<companion_cube> 99.999% of it is :)
<nore> well, anyway, I have made you aware of it, up to you to decide if it's important or not :)
<nore> (I don't think anyone would do that anyway)
<companion_cube> I'm no maintainer
<nore> companion_cube: well, you're a contributor though, as I see
<nore> I saw a few pull requests by you
<nore> I'm but a simple user :)
cannedprimates has left #ocaml [#ocaml]
<Drup> nore: you should still report it: http://caml.inria.fr/mantis/view_all_bug_page.php
<nore> Drup: ok, I'll do that this evening then
<hcarty> rgrinberg: I've hacked in some streaming support too
<hcarty> rgrinberg: Still very much a WIP
<hcarty> Not sure what will come of it yet
<rgrinberg> hcarty: \o/
<hcarty> rgrinberg: Based on very simple, stupid tests it's faster too (which makes sense, it eliminates recursion)
A19774941 has joined #ocaml
ygrek has joined #ocaml
<rgrinberg> Nice. My my main concern is reasonable memory usage but this is nice too
jonasen has quit [Quit: My Mac has gone to sleep. ZZZzzz…]
A1977494 has quit [Ping timeout: 252 seconds]
AlexDenisov has quit [Quit: My Mac has gone to sleep. ZZZzzz…]
Fleurety has quit [Ping timeout: 240 seconds]
A1977494 has joined #ocaml
A19774941 has quit [Ping timeout: 246 seconds]
ygrek has quit [Ping timeout: 272 seconds]
tane has quit [Ping timeout: 258 seconds]
<gasche> I don't think parsing (* ... ( *) as a comment is a bug
<gasche> but I think ( *) could be rejected for the reason that it breaks the invariant that any code can be commented
<gasche> that's probably the reason why this warning was added
<gasche> so nore I would say "no change required" or "won't fix" here
<gasche> (but yes, anyone should feel free to report bugs, send pull requests, and *review others' patches*)
jwatzman|work has quit [Quit: jwatzman|work]
<nore> gasche: well, I don't think it's important
<nore> but well, just mentionning it
<nore> in case you wanted to fix it in some way
agarwal1975 has quit [Quit: agarwal1975]
agarwal1975 has joined #ocaml
tane has joined #ocaml
<tormen> If I know the list has 3 elements, can I do pattern matching to assign the 3 elements to variables ?
<tormen> e.g. something like let f [a::b::c::[]] = ...
<tormen> or let f [a;b;c] = ?
<asmanur> yes but you'll get a warning
<tormen> I know it's easy enough to test, but I was wondering about /why/ it is the former or the latter
<asmanur> both are valid
<asmanur> in a let definition you can use any pattern you like
<tormen> asmanur: hmmm. really ?
<nore> asmanur: actually, the first one would be f a::b::c::[]
<asmanur> yes right--misread it
<nore> tormen: yep
<tormen> nore: yes right :)
octachron has joined #ocaml
<tormen> hmm. The warning is because I am not catching all cases ? ... so I guess it would be better to do the matching within the function with an failwith otherwise...
malc_` has joined #ocaml
<asmanur> yes :)
<pierpa> it would be better if you don't use lists in this way. Almost certainly there's a misdesign lurking there
rgrinberg has quit [Ping timeout: 260 seconds]
<octachron> I think that there is at least one questionable case: "let [x;y;z] = List.map f [x;y;z]" where it obvious that the left side list contains only three arguments
SpiceGuid has joined #ocaml
<octachron> and I don't know generic *and* simple workarounds
<tormen> asmanur: thanks!
struktured has joined #ocaml
<tormen> pierpa: Hmm. I am not sure. I am doing a sql query via pgocaml and get list of lists back ... hmm... YES you are right :D ... of course it's list of TUPLES... *dough*
<pierpa> :)
<tormen> So the world makes sense again :))
octachron has quit [Ping timeout: 252 seconds]
hcarty1 has joined #ocaml
nojb_ has quit [Ping timeout: 272 seconds]
cantstanya is now known as cartwright
hcarty has quit [Ping timeout: 276 seconds]
cartwright is now known as frank
frank is now known as Frank
<mrvn> if you don't care about misuse there is always x::y::z::_
nojb_ has joined #ocaml
octachron has joined #ocaml
<nore> mrvn: this is still not exhaustive anyway
<mrvn> yeah, you have to catch 0, 1 and 2 too
<mrvn> why?
<mrvn> ups
dexterph has quit [Ping timeout: 250 seconds]
wiredsister has joined #ocaml
<tormen> Hmm. Can one query with pgocaml like this: PGSQL(dbh) "SELECT id from mytable WHERE id in $ids" and $ids being a list that will be transformed into (1, 2, 3, 4) in the query for instance ?
jonasen has joined #ocaml
<pierpa> this may be one case where your list matching may be justified
AlexDenisov has joined #ocaml
freusque has quit [Quit: WeeChat 1.4]
<tormen> Hmm. How can I precise the type when using a variant constructor ?
<mrvn> you can't. do you mean polymorphic variant?
<octachron> (A : typename)?
<tormen> mrvn: no regular variant
ygrek has joined #ocaml
<mrvn> then rephrase your question
<SpiceGuid> GADT allow variant constructor with a phantom type.
<SpiceGuid> Otherwise there is the *constraint* keyword that allow you to restrict type polymorphism.
Algebr` has joined #ocaml
agarwal1975 has quit [Quit: agarwal1975]
AlexDenisov has quit [Quit: My Mac has gone to sleep. ZZZzzz…]
<mrvn> so does the uefi example in the wiki work yet?
<mrvn> args, sorry.
agarwal1975 has joined #ocaml
<tormen> mrvn: Hmm. type a = |A of string |B of int ; type b = |List_of of a list |A of string |B of int then A is confusing for the compiler. So I try to hint him that I mean A from type a when
<mrvn> Put them in different modules
<tormen> constructing a list of type a elements before plugging it in a List_of (of type b).
<mrvn> and improve your naming skills
<tormen> hehe
tane has quit [Ping timeout: 250 seconds]
* tormen is just lazy typing here...
<mrvn> do you need 2 types?
<mrvn> type a = |List_of of a list |A of string |B of int
<tormen> mrvn: I tried it with one... Yojson did not like it ;) ... i suppose the recursive variant
darkf__ has quit [Quit: Leaving]
<mrvn> type b = List of a list | Item of a
<tormen> ... I was wondering about this one
<octachron> tormen, adding a type annotation should work , e.g. (A:a) or (A:b)
dhil has quit [Ping timeout: 272 seconds]
struktured has quit [Ping timeout: 250 seconds]
wiredsister has quit [Ping timeout: 264 seconds]
dave24 has quit [Quit: leaving]
A1977494 has quit [Quit: Leaving.]
manizzle has joined #ocaml
tane has joined #ocaml
<tormen> octachron: thanks!
<tormen> mrvn: Likewise :)
SpiceGuid has quit [Quit: ChatZilla 0.9.92 [SeaMonkey 2.40/20160120202951]]
martinkl_ has joined #ocaml
rgrinberg has joined #ocaml
agarwal1975 has quit [Quit: agarwal1975]
agarwal1975 has joined #ocaml
<cheater> companion_cube: ohhh thanks :-)
<cheater> companion_cube: that's great! thank you!
<companion_cube> hmm?
rand__ has quit [Quit: leaving]
<cheater> opam installation command :)
<companion_cube> ah!
struktured has joined #ocaml
jonasen has quit [Quit: My Mac has gone to sleep. ZZZzzz…]
shinnya has quit [Ping timeout: 264 seconds]
StrykerKKD has joined #ocaml
struktured has quit [Read error: Connection reset by peer]
Kakadu has quit [Quit: Page closed]
dakk has joined #ocaml
danieli has quit [Excess Flood]
AlexDenisov has joined #ocaml
danieli has joined #ocaml
<Drup> aantron: do you have an allinone press-button "turn my tests into this coverall thingy" example ? ^^
<Drup> (with oasis + ocaml-travisci-skeleton)
nbecker has joined #ocaml
<nbecker> q
nbecker has quit [Quit: WeeChat 1.5]
Kakadu has joined #ocaml
nbnb has joined #ocaml
wiredsister has joined #ocaml
slash^ has quit [Read error: Connection reset by peer]
danieli has quit [Excess Flood]
danieli has joined #ocaml
danieli has quit [Max SendQ exceeded]
danieli has joined #ocaml
danieli has quit [Max SendQ exceeded]
danieli has joined #ocaml
danieli has quit [Max SendQ exceeded]
danieli has joined #ocaml
danieli has quit [Client Quit]
inr_ has joined #ocaml
inr has quit [Ping timeout: 240 seconds]
nbnb has quit [Read error: Connection reset by peer]
nbnb has joined #ocaml
nbnb has left #ocaml [#ocaml]
<pierpa> If someone needs it and has missed the Breaking news: registrations are now open for session 2 of the OCaml MOOC! https://www.fun-mooc.fr/courses/parisdiderot/56002S02/session02/about
MercurialAlchemi has quit [Ping timeout: 252 seconds]
<tane> pierpa, thanks for the information :)
<pierpa> yw. It's a nice mooc
<hcarty1> pierpa: Thanks!
hcarty1 is now known as hcarty
AlexDenisov has quit [Quit: My Mac has gone to sleep. ZZZzzz…]
sfri has quit [Remote host closed the connection]
Nash_ has joined #ocaml
<Nash_> Hi there!
<Nash_> anyone here ? ;)
sepp2k has quit [Quit: Leaving.]
<Algebr`> hi
<Algebr`> whatsup
<Nash_> hehe :) <
<Nash_> its a long time ago i was using irc ;)
<Nash_> i was wondering if anyone is using Labltk with Eclipse ?
<Algebr`> to be honest this is unlikely that someone on will fit that usage.
shinnya has joined #ocaml
<Nash_> oh? why?
<Algebr`> because eclipse is not a very popular tool that OCaml programmers use? At least in my limited experience.
<Nash_> oh.. ok
<apache2> does eclipse have ocaml support?
<hcarty> apache2: There were a few projects adding support. They're all fairly out of date I think
tane has quit [Quit: Leaving]
<Algebr`> exactly my point heh.
sfri has joined #ocaml
<hcarty> Nash_: The best/most complete IDE-ish support is currently available in vim, emacs, atom and VS Code
<hcarty> Nash_: Lots of other editors provide at least basic syntax highlighting support
<apache2> 20
<apache2> oops.
malc_` has quit [Remote host closed the connection]
<Nash_> ok :( but my projet is almost finished in eclipse, i just need to include a Labltk lib to finalize it :(
<Nash_> i need to add the directory labltk as i would do when interprete it with #directory +labltk
danieli has joined #ocaml
danieli has quit [Changing host]
danieli has joined #ocaml
wiredsister has quit [Remote host closed the connection]
Nash_ has quit [Quit: Page closed]
octachron has quit [Quit: Leaving]
rgrinberg has quit [Ping timeout: 260 seconds]
dakk has quit [Ping timeout: 252 seconds]
AltGr has left #ocaml [#ocaml]
AlexRussia has quit [Ping timeout: 246 seconds]
martinkl_ has quit [Quit: My MacBook has gone to sleep. ZZZzzz…]
dakk has joined #ocaml
inr_ has quit [Ping timeout: 250 seconds]
sfri has quit [Remote host closed the connection]
companion_cube has quit [Ping timeout: 260 seconds]
companion_cube has joined #ocaml
Sorella has joined #ocaml
abeaumont has quit [Remote host closed the connection]
nojb_ has quit [Ping timeout: 276 seconds]
sfri has joined #ocaml
troydm has quit [Ping timeout: 244 seconds]
troydm has joined #ocaml
StrykerKKD has quit [Quit: Leaving]
picolino has quit [Ping timeout: 276 seconds]
AlexRussia has joined #ocaml
Algebr` has left #ocaml ["ERC (IRC client for Emacs 25.1.50.1)"]
picolino has joined #ocaml
rgrinberg has joined #ocaml
beginner_ has joined #ocaml
beginner has quit [Read error: Connection reset by peer]
hcarty has quit [Quit: WeeChat 1.5]
Kakadu has quit [Remote host closed the connection]
silver_ has joined #ocaml
silver has quit [Ping timeout: 240 seconds]
silver_ has quit [Client Quit]
picolino has quit [Ping timeout: 240 seconds]
picolino has joined #ocaml
picolino has quit [Ping timeout: 240 seconds]
picolino has joined #ocaml
Simn has quit [Read error: Connection reset by peer]
madroach has quit [Ping timeout: 244 seconds]
madroach has joined #ocaml
jeffmo has quit [Quit: jeffmo]
fluter has quit [Ping timeout: 264 seconds]