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>
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
<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]
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
<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
<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
<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]]