<octachron>
You are using Core. Core functions use labels for all its function arguments and always require a monomorphic equality to avoid the polymorphic argument.
<octachron>
Typically, in this case, you forgot the `~equal` argument to the `List.Assoc` function.
<d_bot_>
<gantsev.denis> this compiles:
<d_bot_>
<gantsev.denis> ```
<d_bot_>
<gantsev.denis> let build_counts () =
<d_bot_>
<gantsev.denis> In_channel.fold_lines In_channel.stdin ~init:[] ~f:(fun counts line ->
<d_bot_>
<gantsev.denis> let count =
<d_bot_>
<gantsev.denis> match List.Assoc.find ~equal:(fun a b -> String.equal a b) counts line with
<d_bot_>
<gantsev.denis> | None -> 0
<d_bot_>
<gantsev.denis> | Some x -> x
<d_bot_>
<gantsev.denis> in
<d_bot_>
<gantsev.denis> List.Assoc.add ~equal:(fun a b -> String.equal a b) counts line (count + 1))
Anarchos has quit [Quit: Vision[]: i've been blurred!]
mro has quit [Remote host closed the connection]
<d_bot_>
<NULL> `~equal:String.equal` is enough, no need for eta-expansion
mro has joined #ocaml
<d_bot_>
<VPhantom> I wonder if `String.(~equal)` would compile… nope. Would've been cute though. 😛
<d_bot_>
<NULL> I tried variations of it as well
cedric has joined #ocaml
<d_bot_>
<gantsev.denis> Oh true. Didn't think of that
mro has quit [Remote host closed the connection]
wingsorc has quit [Quit: Leaving]
jonasbits has quit [Ping timeout: 248 seconds]
mro has joined #ocaml
bobo_ has joined #ocaml
spip has quit [Ping timeout: 240 seconds]
jonasbits has joined #ocaml
mro has quit [Remote host closed the connection]
troydm has quit [Ping timeout: 248 seconds]
mro has joined #ocaml
adanwan has quit [Remote host closed the connection]
adanwan has joined #ocaml
mro has quit [Ping timeout: 240 seconds]
mro has joined #ocaml
Anarchos has joined #ocaml
bobo_ has quit [Ping timeout: 240 seconds]
bobo_ has joined #ocaml
Haudegen has quit [Quit: Bin weg.]
jonasbits has quit [Quit: No Ping reply in 180 seconds.]
jonasbits has joined #ocaml
xgqt has quit [Ping timeout: 255 seconds]
xgqt has joined #ocaml
gereedy has joined #ocaml
rgrinberg has joined #ocaml
Haudegen has joined #ocaml
mro has quit [Remote host closed the connection]
mro has joined #ocaml
cross has joined #ocaml
mro has quit [Remote host closed the connection]
troydm has joined #ocaml
trev has quit [Remote host closed the connection]
gereedy has quit [Ping timeout: 248 seconds]
Anarchos has quit [Quit: Vision[]: i've been blurred!]
rgrinberg has quit [Ping timeout: 248 seconds]
rgrinberg has joined #ocaml
noonien has quit [Ping timeout: 248 seconds]
mro has joined #ocaml
noonien has joined #ocaml
doesntgolf has joined #ocaml
szkl has quit [Quit: Connection closed for inactivity]
mro has quit [Remote host closed the connection]
doesntgolf has quit [Remote host closed the connection]
mro has joined #ocaml
Haudegen has quit [Quit: Bin weg.]
<mjacob>
is it possible to make `dune build` abort on first error?
<rgrinberg>
nope
<mjacob>
when linking (with `ld`) fails, is it possible to show how exactly the `ld` command was executed?
<rgrinberg>
you can look into _build/log to see exactly what dune is running.
<mjacob>
thanks!
nd__ has quit [Ping timeout: 246 seconds]
nd__ has joined #ocaml
mbuf has quit [Quit: Leaving]
nd__ has quit [Ping timeout: 240 seconds]
nd__ has joined #ocaml
mro has quit [Quit: Leaving...]
nd__ has quit [Ping timeout: 240 seconds]
nd__ has joined #ocaml
Haudegen has joined #ocaml
nd__ has quit [Ping timeout: 268 seconds]
nd__ has joined #ocaml
nd__ has quit [Ping timeout: 248 seconds]
nd__ has joined #ocaml
nd__ has quit [Ping timeout: 248 seconds]
nd__ has joined #ocaml
nd__ has quit [Ping timeout: 268 seconds]
nd__ has joined #ocaml
nd__ has quit [Ping timeout: 268 seconds]
nd__ has joined #ocaml
nd__ has quit [Ping timeout: 268 seconds]
nd__ has joined #ocaml
nd__ has quit [Ping timeout: 248 seconds]
nd__ has joined #ocaml
nd__ has quit [Ping timeout: 248 seconds]
nd__ has joined #ocaml
nd__ has quit [Ping timeout: 240 seconds]
nd__ has joined #ocaml
nd__ has quit [Ping timeout: 240 seconds]
nd__ has joined #ocaml
nd__ has quit [Ping timeout: 240 seconds]
nd__ has joined #ocaml
nd__ has quit [Ping timeout: 240 seconds]
nd__ has joined #ocaml
nd__ has quit [Ping timeout: 240 seconds]
nd__ has joined #ocaml
nd__ has quit [Ping timeout: 240 seconds]
nd__ has joined #ocaml
waleee has joined #ocaml
nd__ has quit [Ping timeout: 240 seconds]
nd__ has joined #ocaml
nd__ has quit [Ping timeout: 240 seconds]
nd__ has joined #ocaml
nd__ has quit [Ping timeout: 268 seconds]
nd__ has joined #ocaml
nd__ has quit [Ping timeout: 240 seconds]
nd__ has joined #ocaml
nd__ has quit [Ping timeout: 264 seconds]
nd__ has joined #ocaml
gareppa has joined #ocaml
gareppa has quit [Client Quit]
nd__ has quit [Ping timeout: 268 seconds]
nd__ has joined #ocaml
nd__ has quit [Ping timeout: 264 seconds]
nd__ has joined #ocaml
nd__ has quit [Ping timeout: 264 seconds]
nd__ has joined #ocaml
nd__ has quit [Ping timeout: 268 seconds]
nd__ has joined #ocaml
nd__ has quit [Ping timeout: 248 seconds]
cedric has quit [Quit: Konversation terminated!]
nd__ has joined #ocaml
qwr has quit [Ping timeout: 276 seconds]
nd__ has quit [Ping timeout: 268 seconds]
nd__ has joined #ocaml
nd__ has quit [Ping timeout: 264 seconds]
nd__ has joined #ocaml
<d_bot_>
<ec> I may be misunderstanding the purpose of them, but I'm slightly struggling with destructive substitutions of module-types.
<d_bot_>
<ec> I'm playing around with a module that is basically "a specialized `Hashtbl`"; I want something like `type t = (Version.t, Version.hash) Hashtbl.t`, but without typing out every single `let create = Hashtbl.create`; and the final signature shouldn't show any polymorphism on the type of `Hashtbl`.
<d_bot_>
<ec> I tried something like `type t = (Version.t, Version.hash) Hashtbl.t \n include module type of Hashtbl with t := t`, but I'm getting syntax errors.
<d_bot_>
<Et7f3 (@me on reply)> it is a functor ?
<companion_cube>
you can't write `module Foo : Bar with type 'yolo t := u`
<companion_cube>
it'd be `with type t := t` but you can't do that here, it's polymorphic
<d_bot_>
<ec> ah, yeah, that gives a clearer type-error
<d_bot_>
<ec> "Type declarations do not match: `type t = t/2` is not included in `type ('a, 'b) t = ('a, 'b) t/1`. They have different arities."
<d_bot_>
<ec> the thing is I don't really feel the need to customize the hashing-function or anything?
<d_bot_>
<ec> well, I suppose I can still use that to opaque the type … hrm
nd__ has quit [Ping timeout: 268 seconds]
<companion_cube>
you can use `Hashtbl.hash` to explicitly use the default hash
nd__ has joined #ocaml
<d_bot_>
<ec> Ah, and unfortunately, that still leaves one variable polymorphic, which just returns me to the original problem.
<d_bot_>
<ec> Then, if I, for-no-good-reason, reallllly wanted a `t` with no type-variables, I do indeed have to manually type out `let create = Hashtbl.create; let clear = Hashtbl.clear; let reset = Hashtbl.reset …` in the impl and `val create : ?random:bool -> int -> t; val clear : t -> unit; val reset : t -> unit` in the intf, for each value I want my clone to have?
<sim642>
Why is that a problem though? The hashtable is polymorphic in its values and cannot be misused with any value type
* d_bot_
<ec> mumbles something incoherent about error-messages and user-confusion, then slinks off embarassed
<d_bot_>
<ec> mostly a thought-experiment right now; if it's messy then I won't do it. ¯\_(ツ)_/¯
<d_bot_>
<ec> yeah I thought that the `include, type t` was enough for the impl; unfortunately, still high-n-dry for the intf. no big deal, I think my question is answered — thanks!
rgrinberg has quit [Quit: My MacBook has gone to sleep. ZZZzzz…]
<companion_cube>
same trick probably: `module MyTbl : sig include module type of Hashtbl with type … = … val create : int -> t … end`
<companion_cube>
you can include in sig…end
<sim642>
`type t = (int,string) Hashtbl.t` instead of `type nonrec t = (int,string) t` seems to work as well
<companion_cube>
yes but then you can't substitute I think
<companion_cube>
the intermediate type is there to allow you to substitute `t` away
nd__ has quit [Ping timeout: 268 seconds]
nd__ has joined #ocaml
<d_bot_>
<octachron> Indeed, `type t = (int,string) Hashtbl.t` will be fine, since it will make the implementation fit the signature and the signature constraint will then eliminate the type equation.
<d_bot_>
<octachron> But that will not work for writing the signature.
nd__ has quit [Ping timeout: 246 seconds]
nd__ has joined #ocaml
wingsorc has joined #ocaml
Tuplanolla has joined #ocaml
nd__ has quit [Ping timeout: 256 seconds]
nd__ has joined #ocaml
rgrinberg has joined #ocaml
dextaa has quit [Read error: Connection reset by peer]
dextaa has joined #ocaml
dextaa has quit [Read error: Connection reset by peer]
nd__ has quit [Ping timeout: 248 seconds]
nd__ has joined #ocaml
dextaa has joined #ocaml
dextaa has quit [Read error: Connection reset by peer]
azimut has quit [Write error: Connection reset by peer]
dextaa has joined #ocaml
dextaa has quit [Read error: Connection reset by peer]
azimut has joined #ocaml
nd__ has quit [Ping timeout: 240 seconds]
bartholin has joined #ocaml
dextaa has joined #ocaml
nd__ has joined #ocaml
dextaa has quit [Read error: Connection reset by peer]
dextaa has joined #ocaml
nd__ has quit [Ping timeout: 264 seconds]
nd__ has joined #ocaml
nd__ has quit [Ping timeout: 264 seconds]
nd__ has joined #ocaml
Serpent7776 has quit [Quit: leaving]
nd__ has quit [Ping timeout: 240 seconds]
rgrinberg has quit [Quit: My MacBook has gone to sleep. ZZZzzz…]