adrien changed the topic of #ocaml to: Discussions about the OCaml programming language | http://www.ocaml.org | Upcoming OCaml MOOC: https://huit.re/ocamlmooc | OCaml 4.03.0 release notes: 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
ollehar has quit [Quit: ollehar]
pierpa has quit [Ping timeout: 258 seconds]
Heasummn has quit [Ping timeout: 260 seconds]
benzrf has left #ocaml ["WeeChat 1.5"]
wtetzner has quit [Remote host closed the connection]
hay207_ has joined #ocaml
hay207_ has quit [Ping timeout: 258 seconds]
wtetzner has joined #ocaml
TRUMP-PENCE has quit [Quit: TRUMP-PENCE 2016 #AllLivesForTrump #TrumpNation #TrumpTrain #teamtrump #TrumpPence #NeverHillary #maga #MakeAmericaGreatAgain #HumaTheHoneyPot #BarackBinLaden #CaliphateClinton]
hay207__ has joined #ocaml
hay207__ has quit [Read error: Connection reset by peer]
hay207__ has joined #ocaml
hay207__ has quit [Read error: Connection reset by peer]
hay207__ has joined #ocaml
hay207__ has quit [Read error: Connection reset by peer]
pyon has quit [Quit: Fix <strike>life</strike> config.]
hay207__ has joined #ocaml
pyon has joined #ocaml
ygrek has quit [Ping timeout: 264 seconds]
hay207__ has quit [Read error: Connection reset by peer]
hay207__ has joined #ocaml
hay207__ has quit [Read error: Connection reset by peer]
hay207__ has joined #ocaml
hay207__ has quit [Read error: Connection reset by peer]
hay207__ has joined #ocaml
hay207__ has quit [Read error: Connection reset by peer]
hay207__ has joined #ocaml
hay207__ has quit [Read error: Connection reset by peer]
hay207__ has joined #ocaml
hay207__ has quit [Read error: Connection reset by peer]
hay207__ has joined #ocaml
hay207__ has quit [Read error: Connection reset by peer]
hay207__ has joined #ocaml
hay207__ has quit [Read error: Connection reset by peer]
hay207__ has joined #ocaml
lolisa has joined #ocaml
shon has quit [Read error: Connection reset by peer]
shon has joined #ocaml
shon has quit [Read error: Connection reset by peer]
shon has joined #ocaml
lolisa has quit [Ping timeout: 260 seconds]
copy` has quit [Quit: Connection closed for inactivity]
shon has quit []
wtetzner has quit [Remote host closed the connection]
nicooo has joined #ocaml
ygrek has joined #ocaml
nicoo has quit [Ping timeout: 244 seconds]
sdothum has quit [Quit: ZNC - 1.6.0 - http://znc.in]
al-damiri has quit [Quit: Connection closed for inactivity]
tmtwd has joined #ocaml
wtetzner has joined #ocaml
wtetzner has quit [Ping timeout: 244 seconds]
MercurialAlchemi has joined #ocaml
slash^ has joined #ocaml
MercurialAlchemi has quit [Ping timeout: 265 seconds]
fraggle_ has quit [Ping timeout: 264 seconds]
ggole has joined #ocaml
fraggle_ has joined #ocaml
rgrinberg has quit [Ping timeout: 250 seconds]
tane has joined #ocaml
hay207__ has quit [Quit: Konversation terminated!]
hay207__ has joined #ocaml
mcc has quit [Quit: Connection closed for inactivity]
pierpa has joined #ocaml
bruce_r_ has quit [Ping timeout: 260 seconds]
MercurialAlchemi has joined #ocaml
srcerer has quit [Ping timeout: 258 seconds]
tmtwd has quit [Ping timeout: 276 seconds]
ygrek has quit [Ping timeout: 264 seconds]
antoro_ is now known as antoro
LiamGoodacre has joined #ocaml
soupault has joined #ocaml
shon has joined #ocaml
dexterph has joined #ocaml
MercurialAlchemi has quit [Ping timeout: 240 seconds]
MercurialAlchemi has joined #ocaml
hay207__ has quit [Quit: Konversation terminated!]
hay207__ has joined #ocaml
dhil has joined #ocaml
hay207__ has quit [Quit: Konversation terminated!]
hay207__ has joined #ocaml
djellemah has quit [Quit: Leaving]
wolfcore has quit [Ping timeout: 250 seconds]
wolfcore has joined #ocaml
kev has joined #ocaml
fraggle_ has quit [Read error: Connection reset by peer]
govg has quit [Read error: No route to host]
govg has joined #ocaml
fraggle_ has joined #ocaml
rgrinberg has joined #ocaml
dexterph has quit [Ping timeout: 276 seconds]
kev has quit [Ping timeout: 260 seconds]
tane has quit [Ping timeout: 258 seconds]
Algebr` has joined #ocaml
sdothum has joined #ocaml
kev has joined #ocaml
sdothum has quit [Quit: ZNC - 1.6.0 - http://znc.in]
sdothum has joined #ocaml
fraggle-boate has quit [Ping timeout: 252 seconds]
shon has quit [Remote host closed the connection]
tane has joined #ocaml
tane has quit [Ping timeout: 244 seconds]
SilverKey has quit [Quit: Halted.]
tane has joined #ocaml
kev has quit [Ping timeout: 264 seconds]
Simn has joined #ocaml
qrntz has joined #ocaml
darkf has quit [Ping timeout: 250 seconds]
Sim_n has joined #ocaml
Simn has quit [Ping timeout: 264 seconds]
<qrntz> Hello. I would love if someone more experienced could kindly shed some light on an issue I'm having.
<qrntz> Basically, I want to restrict the result Hashtbl.t to the polymorphic variant as its key type but I can't find a way to annotate that explicitly and I'm not really sure why the inference doesn't work as I think it should.
<Algebr`> you can do things like: type foo = [`A | `B]
<qrntz> I know. I want to avoid enumerating the type.
<Algebr`> you can also directly define it in the signature
<qrntz> In the type context, that is.
<Algebr`> t : [`A | `B]
<qrntz> I can do it with a function sure enough, since functions that enumerate the inhabitants of a variant type in a match statement restrict it to [< ...]
<Algebr`> the [< ] thing will happen if you don't enumerate it, but if the type signature has it written right in it, then it will be a [], not < or >
<qrntz> But a function would only allow using the first field as key while I want to leave the assoc list intact so that lookups can happen on any of the 3 fields.
<Algebr`> example: let log (event : [`exn of exn | `misc | `plugged_inout | `tunnel]) message =
<Algebr`>
<qrntz> I'm not sure I understand you there… I want to avoid specifying the full signature for the type and supply a first-class value as the type carrier. For this purpose, all that's needed is for it to be a polymorphic variant type 'a and the resulting Hashtbl.t to be a ('a, _) Hashtbl.t
<qrntz> Well, ('a, string)
<Algebr`> Then I am not clear what you want
<Algebr`> you want the key to be anything
<flux> qrntz, I think the question is what do you want the type of new_elem to be?
<qrntz> The compiler tries to generalize it to [> … ] and ends up with a non-generalized _[> ...] while what I want is a [ … ] or [< … ]
<flux> qrntz, ie. would it contain polymorphic types?
<qrntz> Only as keys.
<qrntz> So an ('a, string) Hashtbl.t where 'a is defined by the first field of flist
<flux> I don't think that can happen ever. if the type is 'a, it means you can put in strings and get out integers?
<flux> btw, this works, leaving the binding to lname, new_elem to someone else: let mk_lname_new_elem () = type_htbl flist
<qrntz> Not generic 'a, but ([> `ID | ... ] as 'a)
<qrntz> Err, [< `ID | ... ]
<qrntz> My bad
<qrntz> Hmm, you're right in that it compiles. Let me check if that works in the actual codebase…
<Algebr`> I don't understand the motivation for this complicated signature, what is the motivation?
<flux> I think he wants to have a few containers that each have at least `ID permitted as a key
<flux> though it doesn't really guarantee the `ID element exists there.
<qrntz> Nope, it triggers the error at the binding site now.
<flux> qrntz, do you need to export that binding?
<qrntz> No, it's module-internal.
<flux> qrntz, do you have foo.mli?
<flux> I guess not
<flux> make an empty modulename.mli
<flux> (in fact that would have solved the original problem without any intermediate function if it's in the same file)
seliopou has quit [Ping timeout: 250 seconds]
ggole_ has joined #ocaml
ggole has quit [Ping timeout: 265 seconds]
<qrntz> Well… guess I have to export the type after all (only the lookup function on that hash table but still)
pierpa has quit [Remote host closed the connection]
pierpa has joined #ocaml
<qrntz> Algebr`: I want to parameterize a parser (that returns a hash table lookup function) by the list of tokens, corresponding long names and a set of keys that would prohibit calling a non-existent field at compile-time (through typing).
<qrntz> I would also want to avoid enumerating the polymorphic variant key type twice (once in the assoc list and once as a type)
<qrntz> I'm not sure that can be done. But if so, that'd be awesome.
<Algebr`> interesting
<qrntz> Of course the existence of values is not guaranteed in the hash table at runtime, but my concern is only that the keys are narrowly typed.
kev has joined #ocaml
<qrntz> Also, ideally I'd have a few parsers built on this model and they would have to share some field names (i. e. every element has an `ID and a `Name, some have a `Description) so that rules out non-polymorphic variants and GADTs as keys
<Algebr`> hmm, I wonder if open types could be relevant here
<qrntz> What bothers me the most is that it can be done with pattern-matching functions (the type is restricted to the subset that is matched against if there is no catch-all).
<qrntz> But as I said, I need to have all fields of the assoc list as potential keys.
<qrntz> Extensible variants?
<qrntz> I pondered upon that for a while but the extensions would be module-local unlike polymorphic variants AFAIU.
<qrntz> So you'd have to do (lookup element Foo.Name) but (lookup element Bar.Description) and it would kind of enforce an inheritance-like hierarchy which I'd like to avoid.
<qrntz> Might be I don't understand them fully though.
<qrntz> Oh, and you'd have to enumerate the variants in a type context before using them. Which is also something I'm trying to avoid here. :-)
silver has joined #ocaml
<qrntz> In this case, I find even Obj.magic doesn't help much because I couldn't find a way to tell it that I would like to close a polymorphic variant type, not generalize it.
<qrntz> Not that it's a good idea to use in the end but at least it'd help me understand how to do that.
<mrvn> Looks like you need to use a universal type and write all your code to ignore elements they don't know.
silver_ has joined #ocaml
<mrvn> ou can't get around some sort of inheritance or dependency because you need all modules to agree to unique identifiers in some form or another.
<mrvn> Using open types or exceptions leaves that the most hidden.
silver has quit [Ping timeout: 276 seconds]
pierpa has quit [Ping timeout: 258 seconds]
soupault has quit [Remote host closed the connection]
Algebr` has quit [Ping timeout: 240 seconds]
<qrntz> mrvn: Aren't polymorphic variants unique enough though? If you've got two functions in two modules that both accept e. g. [< `Foo | `Bar] and produce the same output it seems to me that they are type-equivalent.
<qrntz> And would both be able to accept a `Foo from a third module.
<mrvn> qrntz: ocaml makes sure they are globally unique. I complains if you cause a hash collision.
<mrvn> and if two modules have `Foo of int but mean different things then you have problems. They depend on a common meaning.
<qrntz> I'm not looking to have n-ary variant constructors, just nullary ones.
<qrntz> And the meaning would, in fact, be the same.
bruce_r has joined #ocaml
<qrntz> Only some modules' lookup functions accept a super-/subset of other modules' lookup functions' input types, parameterized by a first-class value.
tane has quit [Quit: Leaving]
<qrntz> Which, technically, could be supplied to a first-class module generator or a functor — I tried that but it didn't work either because ocamlopt said «The module to be unpacked contains variables»
<qrntz> (since it tried to generalize _[> `ID | ... ]
<qrntz> )
<qrntz> Not sure if I'm making myself clear but I hope so.
ghtdak has quit [Quit: WeeChat 1.3]
Sim_n has quit [Read error: Connection reset by peer]
govg has quit [Ping timeout: 260 seconds]
govg has joined #ocaml
dexterph has joined #ocaml
AlexRussia has joined #ocaml
<Drup> qrntz: why don't you use a non-polymorphic hashtable ? without any [> or [< ?
<Drup> you'll still be able to put things in it
qrntz_ has joined #ocaml
<qrntz_> Drup: what do you mean? I want to restrict the key type at compile time.
wtetzner has joined #ocaml
AlexRussia has quit [Ping timeout: 244 seconds]
<Drup> hum, I guess you can't do that without writing out the variants :/
qrntz has quit [Ping timeout: 264 seconds]
atsampson has quit [Ping timeout: 258 seconds]
wtetzner has quit [Remote host closed the connection]
<Drup> qrntz_: why don't you want to spell out the type ? You're going to have to write it in the .mli anyway
APNG has quit [Quit: Leaving]
Soni has joined #ocaml
Soni is now known as APNG
kev has quit [Ping timeout: 264 seconds]
FreeBirdLjj has joined #ocaml
tane has joined #ocaml
SilverKey has joined #ocaml
silver_ is now known as silver
ghtdak has joined #ocaml
Simn has joined #ocaml
azertyaaaaaaa has joined #ocaml
azertyaaaaaaa has quit [Client Quit]
qrntz_ has quit [Ping timeout: 264 seconds]
seliopou has joined #ocaml
ghtdak has quit [Quit: WeeChat 1.3]
_y has joined #ocaml
FreeBirdLjj has quit [Remote host closed the connection]
srcerer has joined #ocaml
Heasummn has joined #ocaml
bruce_r has quit [Ping timeout: 260 seconds]
ghtdak has joined #ocaml
slash^ has quit [Read error: Connection reset by peer]
slash^ has joined #ocaml
<Heasummn> But Real World Ocaml uses Core.Std
<Heasummn> nvm that
nicooo has quit [Remote host closed the connection]
nicooo has joined #ocaml
tmtwd has joined #ocaml
shon has joined #ocaml
shon has quit [Ping timeout: 252 seconds]
atsampson has joined #ocaml
nicooo is now known as nicoo
al-damiri has joined #ocaml
kev has joined #ocaml
bruce_r has joined #ocaml
tmtwd has quit [Ping timeout: 252 seconds]
govg has quit [Quit: leaving]
AlexRussia has joined #ocaml
soupault has joined #ocaml
kev has quit [Ping timeout: 260 seconds]
kev has joined #ocaml
Heasummn has quit [Ping timeout: 258 seconds]
jackweirdy has joined #ocaml
sigjuice has quit [Ping timeout: 252 seconds]
vodkaInferno has quit [Read error: Connection reset by peer]
vodkaInferno has joined #ocaml
wagle has quit [Remote host closed the connection]
__rlp has quit [Ping timeout: 252 seconds]
wagle has joined #ocaml
__rlp has joined #ocaml
sigjuice has joined #ocaml
manizzle has quit [Ping timeout: 240 seconds]
govg has joined #ocaml
shon has joined #ocaml
shon has quit [Ping timeout: 244 seconds]
kev has quit [Ping timeout: 260 seconds]
soupault has quit [Remote host closed the connection]
ontologiae has joined #ocaml
slash^ has quit [Read error: Connection reset by peer]
jackweirdy has quit [Quit: My MacBook Pro has gone to sleep. ZZZzzz…]
<Drup> I can't manage to give a good API for furl, it's very frustrating :<
ygrek has joined #ocaml
octachron has joined #ocaml
ontologiae has quit [Ping timeout: 244 seconds]
<octachron> Drup, is the value restriction still one of the main hurdle?
<Drup> basically, yes
<Drup> and all the workaround I can think of don't work
jackweirdy has joined #ocaml
<Drup> I could make it work with infix constructors, but I need several of them. I can't simply reuse ::
<Drup> (It would not be great, but it would be okay)
<Drup> (there is the solution to use an append-centric datatype, like tyre, instead of a snoc-centric datatype, but it leads to other annoying things)
al-damiri has quit [Quit: Connection closed for inactivity]
kakadu has joined #ocaml
<octachron> If you need multiple constructors, maybe an option would be to reverse the control of type-level function: have different kind of gadt constructor as element,
tane has quit [Ping timeout: 250 seconds]
<Drup> yes, I tried that, it doesn't work
<octachron> and have (::) apply the type-level function contained in the gadt?
<Drup> this is a tentative of what you said
<Drup> the type of l is not the right one, and L.make will not type
<Drup> basically, you don't want to count the elements in the list, you want to count the holes, and there are elements that are not holes (the constants)
<octachron> Drup, I have something similar for slice in https://github.com/Octachron/tensority/blob/master/lib/mask.mli#L39
<Drup> although, something might work.
laserpants has joined #ocaml
<Drup> bleh, that will be a bit type-ugly :(
juffree has joined #ocaml
MercurialAlchemi has quit [Ping timeout: 240 seconds]
<octachron> if it was only just a bit type-ugly
<Drup> https://bpaste.net/show/ee19c3adc6d2 that works, but it's unsatisfying.
SilverKey has quit [Quit: Halted.]
<Drup> first, because :: as the wrong associativity, I want to be able to snoc, not cons. Second, because the intermediate types are, well, crap
juffree has quit [Ping timeout: 250 seconds]
tane has joined #ocaml
fraggle_ has quit [Ping timeout: 264 seconds]
<octachron> I fear I am completely desensitized to atrocious type; but yes the associativity problem sounds cumbersome (would it work better in arabic and other RTL language?)
Simn has quit [Read error: Connection reset by peer]
<Drup> I'm affraid urls are scno-oriented, regardless of the language. :3
<Drup> snoc*
<Drup> you add at the end, not the beginning.
fraggle_ has joined #ocaml
<rfk> i've never seen this syntax with type url = | [] ... | (::) : ... , what is this called ?
<rfk> maybe i'm just forgetting, haven't used ocaml in a while
<octachron> Drup, ah yes, so it would only work for readers familiar with both reading directions
<Drup> rfk: it's regular type declaration, but it uses the list constructors, [] and ::
LiamGoodacre has quit [Quit: Leaving]
<Drup> (it's from ocaml 4.02.3)
<octachron> rfk, and the syntax type t = A : 'any -> t is for GADTs
<rfk> yeah, i got the GADT part, just never seen [] and :: in tehre
<Drup> yeah, it's rather new, and not extremly known (which is probably a good thing :D)
<rfk> heh
<octachron> ( one of the advantages being that [a;b;c;d] is strictly equivalent to a :: b :: c :: d :: [] for the compiler)
<octachron> Drup, I imagine another option would be to prove that generalizing these kind of phantom type parameter is sound, and then relaxing the value restriction within the compiler
<Drup> Yes
<Drup> that's something I asked, but it wasn't very well received x)
<Drup> and given that the use case for this kind of parameters are pretty much only type-level lists, we might as well add real type level lists, like in GHC.
AlexRussia has quit [Ping timeout: 265 seconds]
kev has joined #ocaml
<Drup> hum, actually, maybe I didn't asked that one
jackweirdy has quit [Quit: Textual IRC Client: www.textualapp.com]
tane has quit [Ping timeout: 244 seconds]
shon has joined #ocaml
shon has quit [Ping timeout: 244 seconds]
tane has joined #ocaml
strykerkkd has joined #ocaml
ggole_ has quit []
tane has quit [Quit: Leaving]
pyon has quit [Quit: Fix config.]
pyon has joined #ocaml
dhil has quit [Ping timeout: 240 seconds]
dexterph has quit [Ping timeout: 244 seconds]
antoro is now known as antoro_
ontologiae has joined #ocaml
ontologiae has quit [Ping timeout: 276 seconds]
unbalancedparen has joined #ocaml
unbalancedparen has quit [Client Quit]
SilverKey has joined #ocaml
darkf has joined #ocaml
kakadu has quit [Remote host closed the connection]
shon has joined #ocaml
octachron has quit [Quit: Leaving]
bruce_r has quit [Remote host closed the connection]
bruce_r has joined #ocaml
silver has quit [Quit: rakede]
thizanne has quit [Quit: WeeChat 1.5]
kev has quit [Ping timeout: 260 seconds]