<d_bot>
<gar> A question about packed modules. Leaving aside questions of efficiency and convenience, does using pack/for-pack give me anything that I could not get by concatenating the sourcee files of the submodules, wrapping each in the appropriate module declaration?
bmo has joined #ocaml
bmo has quit [Ping timeout: 265 seconds]
rgrinberg has joined #ocaml
mro has quit [Quit: Leaving...]
andreypopp has joined #ocaml
<companion_cube>
packed modules are values, so you can carry them around without knowing which actual concrete module you have
<companion_cube>
a bit like objects
bmo has joined #ocaml
average has quit [Quit: Connection closed for inactivity]
jonasbits has joined #ocaml
<rgrinberg>
companion_cube i think your unix example is slower because unix is first reading the data into a temp buffer
<rgrinberg>
and only then copying it to your buffer
<companion_cube>
but why?
<companion_cube>
where is the buffer?
<companion_cube>
if anything it should be `buf` which is slower
<rgrinberg>
look at unix_read
<companion_cube>
hum
<companion_cube>
why does it do that? :/
<companion_cube>
I imagine in_channel has the same
<rgrinberg>
it does not
<rgrinberg>
channel uses caml_read_fd which reads it into the buffer directly
<rgrinberg>
basically, don't use Unix.read/write for anything performance sensitive
<companion_cube>
indeed, i just opened the source
<companion_cube>
but why does Unix do that?
<companion_cube>
instead of a single syscall?
<companion_cube>
yeah TIL
<companion_cube>
I thought it'd be more bare metal by nature…
<rgrinberg>
it is a single syscall
<rgrinberg>
it's just a pointless temp buf
<d_bot>
<Anurag> To deal with blocking calls maybe? I could be wrong but is this defense against the use provided bytes being moved by the GC?
<companion_cube>
but in a blocking call, no one else will trigger the GC
<rgrinberg>
before the read/write the lock is released
<rgrinberg>
actually, i think it's because channel has only a single buffer
<rgrinberg>
while Unix.read/write allocates the buffer on every call
<companion_cube>
the enter_blocking_section releases the runtime lock? heh
<companion_cube>
makes sense I guess.
<companion_cube>
so it doesn't have to do that for in_channel because, being in C, it won't be moved?
<rgrinberg>
with the channel, it reads it first into an internal buffer and only then moves it to your byte
<rgrinberg>
the key is that this buffer is reused between calls
<companion_cube>
yeah
<companion_cube>
crazy
<companion_cube>
and so the solution that directly syscalls into a `bytes` doesn't work because it can't release the runtime lock, correct?
<d_bot>
<gar> @companion_cube I don't follow you, can you elaborate? What does "packed modules are values" mean? "Carry them around"?
<rgrinberg>
well you can keep the lock for the duration of the Unix.read
<rgrinberg>
I'm not sure that's so bad in your case
<companion_cube>
right, but it's bad in the general case I suppose.
<rgrinberg>
but in multi threaded code, other threads will not be able to make progress
<companion_cube>
yep
<companion_cube>
all that because there's no notion of pinned values, I suppose
<rgrinberg>
it's a shame that one either needs to accept fragmentation with bigarrays or extra copying
<companion_cube>
buffers should live for a while
<companion_cube>
it'd be ok to have them being actual C buffers
<companion_cube>
a thing we _really_ lack, anyway, is slices. so many things are harder because of no slices.
<rgrinberg>
what's so hard about passing (buf, pos, len) everywhere?
<companion_cube>
well, for a start, it's an allocation.
<companion_cube>
if you do that for every char, you allocate a shitton
<companion_cube>
and then, everyone can do their own `{buf: bytes; mutable pos: int; mutable len: int}` to at least avoid allocs
<companion_cube>
but that's not compatible with anyone else :?
<companion_cube>
:/
<rgrinberg>
So it's just a matter of adding the slice type to the stdlib then
<rgrinberg>
type 'a slice = { buf : 'a ; mutable pos : int ; mutable len : int }
<rgrinberg>
and off you go
<companion_cube>
if only!
<companion_cube>
(buf also needs to be mutable, I think, btw)
<rgrinberg>
I don't see why
<companion_cube>
well, this is also useful for proper buffers, isn't it?
<companion_cube>
like Buffer.t
<companion_cube>
(which is sadly a bit too private to be useful in general)
<rgrinberg>
Oh I thought you meant the field needs to be mutable
<companion_cube>
yes
<companion_cube>
so it can be redimensionned, in some use cases
<rgrinberg>
or you can just instantiate 'a with a ref
<companion_cube>
yikes
<companion_cube>
I guess that's why bigarrays are better, in a way
<companion_cube>
they don't move… do they?
<rgrinberg>
yes they stay still
<companion_cube>
right
<companion_cube>
so they'd allow `read` to be fast
<rgrinberg>
but they're slow and turn your heap into swiss cheese
<companion_cube>
why are they slow?
<companion_cube>
I mena, they _should_ have fast memcpy, but that's another problem
<rgrinberg>
i don't know but i remember benchmarks showing their get/set is like 2x slower than bytes
<companion_cube>
one must take care to use monomorphic bigarrays
<rgrinberg>
although this isn't the benchmark I remember seeing
<companion_cube>
this is using owl, for all I know it uses polymorphic bigarrays
<rgrinberg>
read sum_big_array. there's no owl there
<companion_cube>
idk if it's monomorphic though
<companion_cube>
at least the layout might be unspecified
<d_bot>
<Anurag> In some benchmarks in the past, i didn't notice a big difference in get/set, but the `sub` operation is slower than bytes. That's where things like cstruct come in
<companion_cube>
yes
<companion_cube>
because sub allocate a new bigarray :s
rgrinberg has quit [Quit: My MacBook has gone to sleep. ZZZzzz…]
<d_bot>
<Et7f3> Slice in golang/vector in cpp have an internal buffer that some times is reallocated and I don't see complain about that.
mro has quit [Remote host closed the connection]
mro has joined #ocaml
mro has quit [Remote host closed the connection]
mro has joined #ocaml
krnkktz has quit [Quit: You have been kicked for being idle]
mro_ has joined #ocaml
mro has quit [Ping timeout: 256 seconds]
bartholin has joined #ocaml
quernd2 has joined #ocaml
quernd has quit [Killed (NickServ (GHOST command used by quernd2))]
quernd2 is now known as quernd
Techcable has quit [Ping timeout: 252 seconds]
mro_ has quit [Remote host closed the connection]
jlrnick has quit [Ping timeout: 268 seconds]
gravicappa has quit [Ping timeout: 265 seconds]
<zozozo>
companion_cube: with [@inline] annotations, you should be able to get template-like behavious, no ?
<zozozo>
(thoguh for bigarrays, I'm not sure how much flambda1 does)
namkeleser has joined #ocaml
mro has joined #ocaml
mro has quit [Remote host closed the connection]
fds has joined #ocaml
<companion_cube>
Yeah yeah, and I'd need to trust inline to always work
<zozozo>
well, even if [@inline] can omsetimes have troubles [@inlined] annotations work fairly well and report warnings (that can be made fatal) when they fail
<companion_cube>
I don't like code that only works well with flambda anyway
<d_bot>
<dinosaure> `cstruct` :p
mbuf has quit [Quit: Leaving]
mro has joined #ocaml
mro has quit [Remote host closed the connection]
Techcable has joined #ocaml
jlrnick has joined #ocaml
Haudegen has quit [Quit: Bin weg.]
mro has joined #ocaml
xiongxin has joined #ocaml
x88x88x has joined #ocaml
namkeleser has quit [Quit: Client closed]
jlrnick has quit [Ping timeout: 265 seconds]
gravicappa has joined #ocaml
arg_ has quit [Ping timeout: 256 seconds]
arg_ has joined #ocaml
Haudegen has joined #ocaml
mro has quit [Remote host closed the connection]
shawnw has quit [Ping timeout: 256 seconds]
bartholin has quit [Remote host closed the connection]
bartholin has joined #ocaml
mro has joined #ocaml
mro has quit [Remote host closed the connection]
motherfsck has joined #ocaml
Tuplanolla has joined #ocaml
wingsorc has joined #ocaml
bmo has quit [Ping timeout: 252 seconds]
bmo has joined #ocaml
xiongxin has quit [Remote host closed the connection]
motherfsck has quit [Ping timeout: 265 seconds]
<d_bot>
<Continuation Calculus> I'm trying to define a ppx deriving where each type (even in a list of types defined mutually recursively) can have its own separate attributes
<d_bot>
<Continuation Calculus> the signature of `Ppx.Deriving.Generator.make_x` is `(P.rec_flag * P.type_declaration list) -> P.structure_item list` and doesn't seem to allow that
<d_bot>
<Continuation Calculus> Am I missing something obvious?
<companion_cube>
hmm I don't think you can put different attributes on mutually recursive types
<companion_cube>
the attributes are on the whole block, afaik
mro has joined #ocaml
motherfsck has joined #ocaml
gareppa has joined #ocaml
gareppa has quit [Remote host closed the connection]
Haudegen has quit [Quit: Bin weg.]
waleee has quit [Quit: WeeChat 3.3]
waleee has joined #ocaml
jlrnick has joined #ocaml
mro has quit [Read error: Connection reset by peer]
mro_ has joined #ocaml
mro_ has quit [Client Quit]
Guest1107 has quit [Ping timeout: 265 seconds]
zebrag has joined #ocaml
<d_bot>
<Continuation Calculus> hmmmmm
<d_bot>
<Continuation Calculus> thanks
<d_bot>
<Continuation Calculus> it's actually trivial to solve I think. I can just pass an extra argument that states to which type the thing applies
rgrinberg has joined #ocaml
bmo has quit [Ping timeout: 252 seconds]
bmo has joined #ocaml
Guest1107 has joined #ocaml
bmo has quit [Ping timeout: 256 seconds]
<d_bot>
<VPhantom> Suggestion: someone might want to write and pin a message in this channel to show details of the IRC side of the bridge bot. I haven't used IRC in nearly 20 years and I'm curious to see this channel from the other perspective 😉
Haudegen has joined #ocaml
<companion_cube>
wdym?
jlrnick has quit [Ping timeout: 265 seconds]
bmo has joined #ocaml
motherfsck has quit [Read error: Connection reset by peer]
motherfsck has joined #ocaml
bmo has quit [Remote host closed the connection]
<d_bot>
<VPhantom> (Whoa I needed Google for that acronym… 😛) I mean which server(s) and channel are on the other side of the BOT gateway.
<d_bot>
<Et7f3> only this one
<d_bot>
<VPhantom> No… I mean on the _IRC_ side.
<d_bot>
<VPhantom> What is this Discord channel bridged with on the IRC side.
<hannes>
VPhantom: the server "on the other side" is libera.chat, the channel is #ocaml
bmo has joined #ocaml
<d_bot>
<RegularSpatula> I'm pretty sure both the `input` and the `unix_read` release the runtime... the unix_read function wraps the `read` syscall in `caml_enter_blocking_section`, and the `caml_read_fd` wraps it in `caml_enter_blocking_section_no_pending`
<companion_cube>
yeah, but they can do it for different reasons
bmo has quit [Ping timeout: 240 seconds]
bmo has joined #ocaml
bmo has quit [Ping timeout: 265 seconds]
<d_bot>
<RegularSpatula> Hmm...I've been going through the c code for the unix_read and the in_channel input trying to figure it out
<d_bot>
<RegularSpatula> I think I'm confused as to why rginberg said above that the stack allocated buffer that `unix_read` makes is pointless
<d_bot>
<RegularSpatula> If the buffer you pass in to `unix_read` can move during gc and you release the runtime around the `read` call, what else is there to do in `unix_read` other than allocate a buffer that you know won't move while the runtime is released?
<d_bot>
<RegularSpatula> (as opposed to the read in using the `in_channel` which has its own buffer (that I guess won't move?...idk))
<companion_cube>
in a way, it could use a nonblocking FD and use select to know when it can read, maybe?
<companion_cube>
then when it's ready, do the read without releasing the lock
rgrinberg has quit [Quit: My MacBook has gone to sleep. ZZZzzz…]
<d_bot>
<RegularSpatula> huh interesting
<d_bot>
<RegularSpatula> I saw that benchmark you put on the discuss and the actual timing differences between the in_channel and the unix_read was pretty small...have you seen instances where using unix_read is actually noticeably slower?
VPhantom has joined #ocaml
bmo has joined #ocaml
<companion_cube>
in both cases you're going to have 2 buffers
<companion_cube>
so I think it's normal it takes ± the same time
sluigi has joined #ocaml
rgrinberg has joined #ocaml
<sluigi>
how do you make an empty map?
<sluigi>
I tried Map.empty, but it keeps on asking me for a comparator
<sluigi>
I tried Map.empty (String.equal) but that didn't work either
<d_bot>
<RegularSpatula> ccube: yeah that makes sense
bmo has quit [Ping timeout: 268 seconds]
<d_bot>
<RegularSpatula> Are you using Jane streets Base library?
<d_bot>
<antron> sluigi: provide specifics immediately. what library are you using? what "didn't work"?
<d_bot>
<antron> what was the output you got?
<sluigi>
i'm using Core
<sluigi>
Error: This expression has type string -> string -> bool
<sluigi>
but an expression was expected of type
<sluigi>
('a, 'b) Map.comparator =
<sluigi>
(module Core_kernel__.Comparator.S with type comparator_witness = 'b and type t = 'a)
<sluigi>
I also tried Map.empty (String.comparator) which didn't work either :P
<sluigi>
(module Core_kernel__.Comparator.S with type comparator_witness = 'b and type t = 'a)
<sluigi>
I think I understand the issue but I'm not sure what the correct thing to do is
<d_bot>
<antron> ok i have to defer to someone who uses core. i've stuck only with standard library's Map
VPhantom has left #ocaml [#ocaml]
<d_bot>
<RegularSpatula> `Map.empty (module String)` is what you want
<sluigi>
Can you explain how the types work out
<sluigi>
im particular how (module String) satisfies the ('a, 'cmp) Map.comparator type
<sluigi>
so actually I defined a type alias for string (type name = String) and want the keys to be names, I guess Map.empty (module String) still works, but is there a way to be more precise (to indicate we're using names and not strings)
<d_bot>
<RegularSpatula> Yeah Map.empty actually takes a first class module as its argument
<companion_cube>
(in Base)
<d_bot>
<RegularSpatula> yeah in base...sluigi it's actually a little tricky to get the base types and stuff...for using maps from base the Real world ocaml book is helpful: https://dev.realworldocaml.org/maps-and-hashtables.html
rgrinberg has quit [Quit: My MacBook has gone to sleep. ZZZzzz…]
sluigi has quit [Quit: Client closed]
<d_bot>
<RegularSpatula> If you check the docs for Base.Map, you can follow the signatures and types to see how it works...Map.empty takes `('a, 'cmp) comparator` and if you check that type its a `Comparator.S` which is a module type that specifies a couple things...you'll see that most of the standard base modules satisfy this type
<d_bot>
<RegularSpatula> For String...it has a `comparator_witness` and a `comparator` function of the correct type already defined, so you can use it there
bmo has joined #ocaml
bmo has quit [Ping timeout: 240 seconds]
bartholin has quit [Quit: Leaving]
bmo has joined #ocaml
gravicappa has quit [Ping timeout: 240 seconds]
Guest1107 has quit [Quit: Konversation terminated!]
Anarchos has joined #ocaml
smondet[m] has quit [Ping timeout: 250 seconds]
mclovin has quit [Ping timeout: 250 seconds]
CodeBitCookie[m] has quit [Ping timeout: 260 seconds]
tomku[m] has quit [Ping timeout: 260 seconds]
adibsaad[m] has quit [Ping timeout: 268 seconds]
saltrocklamp[m] has quit [Ping timeout: 268 seconds]
rgrinberg has joined #ocaml
saltrocklamp[m] has joined #ocaml
mro has joined #ocaml
rgrinberg has quit [Quit: My MacBook has gone to sleep. ZZZzzz…]
smondet[m] has joined #ocaml
mro has quit [Remote host closed the connection]
Serpent7776 has quit [Quit: leaving]
mro has joined #ocaml
adibsaad[m] has joined #ocaml
vicfred has joined #ocaml
cedric has joined #ocaml
<d_bot>
<Continuation Calculus> where can i find doc about the `expression option` in `Pexp_fun of Asttypes.arg_label * expression option * pattern * expression`? Can't find any thing that makes it not `None` with astexplorer
adibsaad[m] has quit [Read error: Connection reset by peer]
saltrocklamp[m] has quit [Write error: Connection reset by peer]
smondet[m] has quit [Write error: Connection reset by peer]
mclovin has joined #ocaml
infinity0 has quit [Ping timeout: 268 seconds]
infinity0 has joined #ocaml
<d_bot>
<Continuation Calculus> let's say i already have a ppx deriving. what would be the most straightforward way to convert it to a ppx deriving that also rewrites the initial type?
smondet[m] has joined #ocaml
saltrocklamp[m] has joined #ocaml
CodeBitCookie[m] has joined #ocaml
adibsaad[m] has joined #ocaml
tomku[m] has joined #ocaml
mclovin has quit [Quit: Client limit exceeded: 20000]
saltrocklamp[m] has quit [Quit: Client limit exceeded: 20000]
smondet[m] has quit [Quit: Client limit exceeded: 20000]
tomku[m] has quit [Quit: Client limit exceeded: 20000]
<d_bot>
<rgrinberg> What is "the initial type"?
<d_bot>
<rgrinberg> The type holding the `[@@deriving ]` annotation?
mclovin has joined #ocaml
smondet[m] has joined #ocaml
saltrocklamp[m] has joined #ocaml
tomku[m] has joined #ocaml
CodeBitCookie[m] has quit [Quit: Client limit exceeded: 20000]
waleee has quit [Quit: WeeChat 3.3]
rgrinberg has quit [Quit: My MacBook has gone to sleep. ZZZzzz…]