<discocaml>
<darrenldl> companion_cube: it really does feel like paying a cost 99% of the time, just so for the remaining 1% of the time it looks bit more elegant
<companion_cube>
So, miou it is? :)
<discocaml>
<darrenldl> either that, or riot
<discocaml>
<darrenldl> riot might be a moving target currently if i'm to aim for it now
<discocaml>
<Ada> interesting
pi3ce has joined #ocaml
azimut has quit [Remote host closed the connection]
azimut has joined #ocaml
slothby has quit [Ping timeout: 255 seconds]
slothby has joined #ocaml
<discocaml>
<romain.beauxis> Howdy! Quick question re: `Weak.Make`. The doc seems to contradict itself.
<discocaml>
<romain.beauxis> > A hashing function on keys. It must be such that if two keys are equal according to equal, then they have identical hash values as computed by hash. Examples: suitable (equal, hash) pairs for arbitrary key types include
<discocaml>
<romain.beauxis> >
<discocaml>
<romain.beauxis> > ((=), Hashtbl.HashedType.hash) for comparing objects by structure (provided objects do not contain floats)
<discocaml>
<romain.beauxis> > ((fun x y -> compare x y = 0), Hashtbl.HashedType.hash) for comparing objects by structure and handling nan correctly
<discocaml>
<romain.beauxis> > ((==), Hashtbl.HashedType.hash) for comparing objects by physical equality (e.g. for mutable or cyclic objects).
<discocaml>
<romain.beauxis> > Functor building an implementation of the weak hash set structure. H.equal can't be the physical equality, since only shallow copies of the elements in the set are given to it.
<discocaml>
<romain.beauxis> Which is one is correct? I'm not sure I understand the issue with shallow copies. Is there an alternative to e.g. to weak maps of opaque terms, say object instances for instance?
<discocaml>
<romain.beauxis> Howdy! Quick question re: `Weak.Make`. The doc seems to contradict itself.
<discocaml>
<romain.beauxis> > A hashing function on keys. It must be such that if two keys are equal according to equal, then they have identical hash values as computed by hash. Examples: suitable (equal, hash) pairs for arbitrary key types include
<discocaml>
<romain.beauxis> >
<discocaml>
<romain.beauxis> > ((=), Hashtbl.HashedType.hash) for comparing objects by structure (provided objects do not contain floats)
<discocaml>
<romain.beauxis> > ((fun x y -> compare x y = 0), Hashtbl.HashedType.hash) for comparing objects by structure and handling nan correctly
<discocaml>
<romain.beauxis> > ((==), Hashtbl.HashedType.hash) for comparing objects by physical equality (e.g. for mutable or cyclic objects).
<discocaml>
<romain.beauxis> > Functor building an implementation of the weak hash set structure. H.equal can't be the physical equality, since only shallow copies of the elements in the set are given to it.
<discocaml>
<romain.beauxis> Which is one is correct? I'm not sure I understand the issue with shallow copies. Is there an alternative to e.g. to weak maps of opaque terms, say object instances for instance?
<discocaml>
<romain.beauxis> Howdy! Quick question re: `Weak.Make`. The doc seems to contradict itself.
<discocaml>
<romain.beauxis> > A hashing function on keys. It must be such that if two keys are equal according to equal, then they have identical hash values as computed by hash. Examples: suitable (equal, hash) pairs for arbitrary key types include
<discocaml>
<romain.beauxis> >
<discocaml>
<romain.beauxis> > ((=), Hashtbl.HashedType.hash) for comparing objects by structure (provided objects do not contain floats)
<discocaml>
<romain.beauxis> > ((fun x y -> compare x y = 0), Hashtbl.HashedType.hash) for comparing objects by structure and handling nan correctly
<discocaml>
<romain.beauxis> > ((==), Hashtbl.HashedType.hash) for comparing objects by physical equality (e.g. for mutable or cyclic objects).
<discocaml>
<romain.beauxis> > Functor building an implementation of the weak hash set structure. H.equal can't be the physical equality, since only shallow copies of the elements in the set are given to it.
<discocaml>
<romain.beauxis>
<discocaml>
<romain.beauxis> Which is one is correct? I'm not sure I understand the issue with shallow copies. Is there an alternative to e.g. to weak maps of opaque terms, say object instances for instance?
<discocaml>
<_ggole> The former describes `Hashtbl`, and the latter `Weak`. They have different requirements.
Square has quit [Ping timeout: 268 seconds]
<discocaml>
<romain.beauxis> Ho dang. yeah ok I got tricked by the fact that the hyperlink goes back to the hash module, I thought I was reading a documentation specific to weak hash thanks!
<discocaml>
<romain.beauxis> @_ggole any suggestion to replace physical equality when setting up a weak hash?
<discocaml>
<romain.beauxis> Howdy! Quick question re: `Weak.Make`. The doc seems to contradict itself.
<discocaml>
<romain.beauxis> > A hashing function on keys. It must be such that if two keys are equal according to equal, then they have identical hash values as computed by hash. Examples: suitable (equal, hash) pairs for arbitrary key types include
<discocaml>
<romain.beauxis> >
<discocaml>
<romain.beauxis> > ((=), Hashtbl.HashedType.hash) for comparing objects by structure (provided objects do not contain floats)
<discocaml>
<romain.beauxis> > ((fun x y -> compare x y = 0), Hashtbl.HashedType.hash) for comparing objects by structure and handling nan correctly
<discocaml>
<romain.beauxis> > ((==), Hashtbl.HashedType.hash) for comparing objects by physical equality (e.g. for mutable or cyclic objects).
<discocaml>
<romain.beauxis> > Functor building an implementation of the weak hash set structure. H.equal can't be the physical equality, since only shallow copies of the elements in the set are given to it.
<discocaml>
<romain.beauxis>
<discocaml>
<romain.beauxis> Which is one is correct? I'm not sure I understand the issue with shallow copies. Is there an alternative to e.g. to weak maps of opaque values, say object instances for instance?
<discocaml>
<_ggole> If you really need identity semantics, you can allocate an id and stick it in whatever you are putting in the table (and equality is just equality of ids)
<discocaml>
<_ggole> Ugly but reliable
<discocaml>
<romain.beauxis> yeah I suppose
Serpent7776 has joined #ocaml
<discocaml>
<_ggole> What sort of keys are you using?
<discocaml>
<romain.beauxis> I've got two use case, they're both used to track values that still alive. One case is term from a parser and another one are object classes. I think I'm gonna go with the Id suggestion, I just need to register the hash ID at the time of registration and voila.
<discocaml>
<_ggole> Yeah, it's annoying but not really difficult
<discocaml>
<romain.beauxis> ```ocaml
<discocaml>
<romain.beauxis> module type T = sig
<discocaml>
<romain.beauxis> type t
<discocaml>
<romain.beauxis> end
<discocaml>
<romain.beauxis>
<discocaml>
<romain.beauxis> module Make (T : T) = struct
<discocaml>
<romain.beauxis> type entry = { id : int; value : T.t }
<discocaml>
<romain.beauxis>
<discocaml>
<romain.beauxis> include Weak.Make (struct
<discocaml>
<romain.beauxis> type t = entry
<discocaml>
<romain.beauxis>
<discocaml>
<romain.beauxis> let equal t t' = t.id = t'.id
<discocaml>
<romain.beauxis> let hash t = t.id
<discocaml>
<romain.beauxis> end)
<discocaml>
<romain.beauxis>
<discocaml>
<romain.beauxis> type data = T.t
<discocaml>
<romain.beauxis>
<discocaml>
<romain.beauxis> let mk value = { id = Hashtbl.hash value; value }
<discocaml>
<romain.beauxis> let merge t v = (merge t (mk v)).value
<discocaml>
<romain.beauxis> let add t v = add t (mk v)
<discocaml>
<romain.beauxis> let remove t v = remove t (mk v)
<discocaml>
<romain.beauxis> let find t v = (find t (mk v)).value
<discocaml>
<romain.beauxis> let find_opt t v = Option.map (fun { value; _ } -> value) (find_opt t (mk v))
<discocaml>
<romain.beauxis> let find_all t v = List.map (fun { value; _ } -> value) (find_all t (mk v))
<discocaml>
<romain.beauxis> let mem t v = mem t (mk v)
<discocaml>
<romain.beauxis> let iter fn = iter (fun { value; _ } -> fn value)
<discocaml>
<romain.beauxis> let fold fn = fold (fun { value; _ } acc -> fn value acc)
<discocaml>
<romain.beauxis> end
<discocaml>
<romain.beauxis> ```
<discocaml>
<romain.beauxis> Nope 🙂
mima has joined #ocaml
olle has joined #ocaml
<discocaml>
<_ggole> Hmm, is there any reason why you chose `id = Hashtbl.hash value`? Usually I would just increment an `int ref` to get an id.
neiluj has joined #ocaml
azimut has quit [Ping timeout: 255 seconds]
bartholin has joined #ocaml
<Leonidas>
There's even `incr` in the standard library that does exactly that
<discocaml>
<bluddy5> The problem imo with eio is that everyone making big libraries has an agenda. It's either JS or in this case Mirage. If you have the resources to make something good, somebody's probably paying the bills.
szkl has joined #ocaml
<discocaml>
<dinosaure> my biggest problem with eio is that they're trying to do something big. I don't really like big things because they _perforate_ the way we develop. I prefer small things which can compose "nicely" (with glues) with others projects
<discocaml>
<dinosaure> in that sense, miou is small and I want to keep it small. You won't get everything eio has to offer, but the library gives you the space to integrate what you want.
<adrien>
(maybe you were looking for "permeate" rather than "perforate")
fweht has joined #ocaml
<companion_cube>
I agree with @dinosaure
<companion_cube>
And the bigger problem is that it's big *and* opinionated
a51 has joined #ocaml
a51 has quit [Quit: WeeChat 4.2.0]
szkl has quit [Quit: Connection closed for inactivity]
<discocaml>
<Ada> huh interesting, definitely seems like it has much more to it than lwt vs async
<hiddenman>
companion_cube, re: opam exec - you were right, that helped, thank you
<hiddenman>
actually, i'm not sure why it wasn't necessary with the first project (it requires "containers" as well)
alexherbo2 has joined #ocaml
azimut has joined #ocaml
<discocaml>
<romain.beauxis> yeah good point
<discocaml>
<romain.beauxis> @_ggole here we go:
<discocaml>
<romain.beauxis> ```ocaml
<discocaml>
<romain.beauxis> module type T = sig
<discocaml>
<romain.beauxis> type t
<discocaml>
<romain.beauxis> end
<discocaml>
<romain.beauxis>
<discocaml>
<romain.beauxis> module Make (T : T) = struct
<discocaml>
<romain.beauxis> type entry = { id : int; hash : int; value : T.t }
<discocaml>
<romain.beauxis>
<discocaml>
<romain.beauxis> include Weak.Make (struct
<discocaml>
<romain.beauxis> type t = entry
<discocaml>
<romain.beauxis>
<discocaml>
<romain.beauxis> let equal t t' = t.id = t'.id
<discocaml>
<romain.beauxis> let hash t = t.hash
<discocaml>
<romain.beauxis> end)
<discocaml>
<romain.beauxis>
<discocaml>
<romain.beauxis> type data = T.t
<discocaml>
<romain.beauxis>
<discocaml>
<romain.beauxis> let counter = Atomic.make 0
<discocaml>
<romain.beauxis>
<discocaml>
<romain.beauxis> let mk value =
<discocaml>
<romain.beauxis> { id = Atomic.fetch_and_add counter 1; hash = Hashtbl.hash value; value }
<discocaml>
<romain.beauxis>
<discocaml>
<romain.beauxis> let merge t v = (merge t (mk v)).value
<discocaml>
<romain.beauxis> let add t v = add t (mk v)
<discocaml>
<romain.beauxis> let remove t v = remove t (mk v)
<discocaml>
<romain.beauxis> let find t v = (find t (mk v)).value
<discocaml>
<romain.beauxis> let find_opt t v = Option.map (fun { value; _ } -> value) (find_opt t (mk v))
<discocaml>
<romain.beauxis> let find_all t v = List.map (fun { value; _ } -> value) (find_all t (mk v))
<discocaml>
<romain.beauxis> let mem t v = mem t (mk v)
<discocaml>
<romain.beauxis> let iter fn = iter (fun { value; _ } -> fn value)
<discocaml>
<romain.beauxis> Actually, no. The idea is to track all values that have not been collected without using any assumption on their content (except that the user should not submit non collected ones). Under this assumption, using an increased counter would make two calls to `add` with the same value register them as different values. Then, `Hashtbl.hash` really is the only way to differentiate.
<discocaml>
<_ggole> The problem with `hash` is that you might get collisions, which would tell you that two physically different, structurally different values were the same.
mima has quit [Ping timeout: 268 seconds]
a51 has joined #ocaml
<discocaml>
<romain.beauxis> yeah
<discocaml>
<romain.beauxis> I think `id` works on my case because things are added on init only but it's not gonna be a generally satisfactory solution for sure.
<discocaml>
<romain.beauxis> I think `id` works in my case because things are added on init only but it's not gonna be a generally satisfactory solution for sure.
szkl has joined #ocaml
alexherbo2 has quit [Remote host closed the connection]
alexherbo2 has joined #ocaml
a51 has quit [Quit: WeeChat 4.2.0]
a51 has joined #ocaml
olle has quit [Ping timeout: 268 seconds]
alexherbo2 has quit [Remote host closed the connection]
alexherbo2 has joined #ocaml
amk has quit [Ping timeout: 260 seconds]
alexherbo2 has quit [Remote host closed the connection]
Anarchos has joined #ocaml
azimut has quit [Ping timeout: 255 seconds]
waleee has joined #ocaml
waleee has quit [Ping timeout: 276 seconds]
waleee has joined #ocaml
mima has joined #ocaml
alexherbo2 has joined #ocaml
waleee has quit [Ping timeout: 260 seconds]
waleee has joined #ocaml
azimut has joined #ocaml
Anarchos has quit [Quit: Vision[]: i've been blurred!]
motherfsck has quit [Ping timeout: 260 seconds]
Tuplanolla has joined #ocaml
neiluj has quit [Quit: neiluj]
mima has quit [Ping timeout: 260 seconds]
mima has joined #ocaml
trillion_exabyte has quit [Ping timeout: 268 seconds]
alexherbo2 has quit [Remote host closed the connection]
alexherbo2 has joined #ocaml
amk has joined #ocaml
amk has quit [Ping timeout: 260 seconds]
amk has joined #ocaml
amk has quit [Ping timeout: 260 seconds]
amk has joined #ocaml
amk has quit [Ping timeout: 264 seconds]
amk has joined #ocaml
amk has quit [Ping timeout: 264 seconds]
amk has joined #ocaml
amk has quit [Ping timeout: 252 seconds]
fweht has quit [Quit: Connection closed for inactivity]
gwizon has quit [Remote host closed the connection]
deadmarshal_ has quit [Ping timeout: 255 seconds]
amk has joined #ocaml
amk_ has joined #ocaml
amk has quit [Read error: Connection reset by peer]
amk_ is now known as amk
tremon has joined #ocaml
deadmarshal_ has joined #ocaml
alexherbo2 has quit [Remote host closed the connection]