gildor changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | OCaml 3.12.0 http://bit.ly/aNZBUp
joewilliams is now known as joewilliams_away
joelr has quit [Ping timeout: 248 seconds]
joewilliams_away is now known as joewilliams
emmanuelux has quit [Remote host closed the connection]
wormphlegm has quit [Read error: Operation timed out]
jld has quit [Read error: Operation timed out]
vivanov has joined #ocaml
jld has joined #ocaml
jld has quit [Ping timeout: 260 seconds]
jld has joined #ocaml
dnolen has quit [Quit: dnolen]
joewilliams is now known as joewilliams_away
joewilliams_away is now known as joewilliams
__marius__ has joined #ocaml
lopex has quit []
mjonsson has quit [Remote host closed the connection]
ymasory has quit [Quit: Leaving]
joewilliams is now known as joewilliams_away
kaustuv has quit [Remote host closed the connection]
__marius__ has quit [Remote host closed the connection]
khia0 has joined #ocaml
khia0 has left #ocaml []
jderque has joined #ocaml
joelr has joined #ocaml
philtor has joined #ocaml
joelr_ has joined #ocaml
joelr has quit [Ping timeout: 246 seconds]
joelr_ is now known as joelr
philtor has quit [Ping timeout: 276 seconds]
Tobu has quit [Remote host closed the connection]
Rolands has joined #ocaml
jderque has quit [Quit: leaving]
f[x] has joined #ocaml
ikaros has joined #ocaml
jamii has joined #ocaml
joelr has quit [Quit: joelr]
kaustuv has joined #ocaml
jderque has joined #ocaml
Cyanure has joined #ocaml
ikaros has quit [Remote host closed the connection]
sgnb has quit [Remote host closed the connection]
sgnb has joined #ocaml
larhat has joined #ocaml
edwin has joined #ocaml
waern has joined #ocaml
vivanov has quit [Read error: Connection reset by peer]
waern_ has quit [Ping timeout: 260 seconds]
ygrek has joined #ocaml
joelr has joined #ocaml
<joelr> moin
Fullma has joined #ocaml
penryu has quit [Quit: brb]
ygrek has quit [Ping timeout: 246 seconds]
vivanov has joined #ocaml
jderque has left #ocaml []
kaustuv has left #ocaml []
mlh has quit [Ping timeout: 250 seconds]
<joelr> thelema: ping
<joelr> rproust: ping
* joelr summons the typing fairies :D
jderque has joined #ocaml
Snark has joined #ocaml
jamii has quit [Ping timeout: 246 seconds]
emmanuelux has joined #ocaml
<rproust> joelr: pong
<joelr> yay
<joelr> rproust: any suggestions on my thread?
<rproust> haven't read it yet
<joelr> rproust: https://groups.google.com/forum/#!topic/fa.caml/a824ZN5iV_0
<joelr> rproust: it seems i'm very close but this doesn't work
<joelr> type poll_socket = [<`Pair|`Pub|`Sub|`Req|`Rep|`Dealer|`Router|`Pull|`Push] Socket.t
<joelr> whereas something like this works fine
<joelr> val forwarder : [<`Sub|`Pull] Socket.t -> [`Pub] Socket.t -> unit
<rproust> it might be caused by variance issues
<rproust> I'm still reading the thread
<joelr> i wish i new what variance issues were :D
<joelr> i mean, the definition of what variance is
<larhat> joelr: are you writing third zmq library for ocaml ?
<joelr> larhat: no, i'm fixing pedro's
<joelr> larhat: e.g. i fixed the 2 poll segfaults yesterday
<joelr> larhat: but now need to solve the issue where you can only stick sockets of a single type into a poll set
<joelr> larhat: btw, thanks for that edge/level triggered update link
<larhat> :-) it seems that typing issue may require huge changes in ocaml-zmq
<joelr> larhat: not huge, just typing changes. i don't consider those huge as only the mli needs to be tweaked
<joelr> larhat: regardless, i need to make those changes whether pedro takes them or not.
<joelr> larhat: we need to poll sockets of a different type
<larhat> have you tried external event loop ? such as lwt?
<joelr> larhat: i want to use zmq ;-)
<larhat> joelr: ^
<joelr> larhat: hmm... i haven't seen those ones. will take a look. we are well entrenched with ocaml-zmq, though
<larhat> small library, that allows using zmq sockets in lwt event loop.
<rproust> joelr: if I understand correctly, you want to check a mask on elements in an array and then call a function on each element that is "ready"
<rproust> what's the type of the function you want to call?
ygrek has joined #ocaml
<joelr> larhat: we are also not using lwt at the moment
<joelr> rproust: correct. that function i want to call is read
<rproust> read: string -> int -> int -> int ???
<joelr> rproust: let me see the mli file...
<rproust> sry string -> int -> int -> socket -> int?
<joelr> val recv : ?opt:recv_option -> 'a t -> string
<joelr> rproust: ^ if it helps. that's the original code i'm trying to modify
<Rolands> hi, maybe somebody has tried connect to mssql via from Ocaml ?
<joelr> larhat: i'll keep your library in mind for when i want to use lwt, thanks!
<joelr> rproust: what puzzles me is that this works: val forwarder : [<`Sub|`Pull] Socket.t -> [`Pub] Socket.t -> unit
<rproust> ok, in the last mail of the thread you write: "I get a different error when using of_poll_items with two different socket types:"
hto has joined #ocaml
<joelr> i can pass either `Sub Socket.t or a `Pull Socket.t and it works
<rproust> do you do these two calls in the body of the same function?
<joelr> rproust: yes, o course. i build a poll set (poll items) once
jamii has joined #ocaml
<rproust> it might be the problem
<rproust> here is an example
<joelr> rproust: the difference i was pointing out, though, was between type poll_socket = [>...] Socket.t and type poll_socket = [...] Socket.t
<joelr> rproust: i just want to make sure that i can stick into a poll item a socket of this type [<`Pair|`Pub|`Sub|`Req|`Rep|`Dealer|`Router|`Pull|`Push] Socket.t
<joelr> well, maybe without <
hto_ has quit [Ping timeout: 240 seconds]
<rproust> let f x = x;; let dup f (x, y) = (f x, f y);; f 3;; f "toto";; dup f (3, toto);;
<rproust> the example I gave fails to type check on the last statement
<joelr> rproust: why does "val forwarder : [<`Sub|`Pull] Socket.t -> [`Pub] Socket.t -> unit" allow me to use either `Sub or `Pull, though?
<rproust> it might depend on how you call the function
<rproust> you can't do dup f (3, "toto") but you can do let x = f 3 in let y = f "toto" in (x, y)
<rproust> I'm not sure that it's the same problem you have, but it might be the reason of the typechecker error
<joelr> hmm
<joelr> rproust: unlike your example, though, my types are only different in phantom type
<rproust> doesn't matter
<joelr> hmm
<joelr> rproust: i was just trying to follow http://camltastic.blogspot.com/2008/05/phantom-types.html
<joelr> it seems like i have the same issue and so i can solve it the same way
avsm has joined #ocaml
<rproust> is your typing problem located in the main loop?
<joelr> i'm not sure it matters. it's outside. i first create a `Pull Socket.t and then a `Pub Socket.t. now i want to stick them into a poll set using Poll.of_poll_items
<rproust> yeah, camlstatic's post and your example are indeed classic cases of phantom type usage
<joelr> :D
<joelr> rproust: i should be able to make it work then, should i not?
<rproust> yes
<rproust> can you paste the function where the type checker fails somewhere?
<joelr> it's not a function, it's just a let
<joelr> let poll_set = of_poll_items [| pull, In; pub, Out |] in
<joelr> where pub is let sock = Socket.create context pub in
<rproust> the function which contains this line…
<joelr> and pull is let sock = Socket.create context pull in
<joelr> it's not a function, it's just a let binding
<rproust> ohhh
<rproust> try
<rproust> nevermind
<rproust> I had a stupid idea…
<joelr> ?
<rproust> and did you try using [<…] Socket.t
<rproust> there mention of [>…] and […] on the thread
<joelr> either > or < prompts the 'a error
<joelr> Error: A type variable is unbound in this type declaration.
<joelr> In type
<joelr> ([< `Dealer | `Pair | `Pub | `Pull | `Push | `Rep | `Req | `Router | `Sub ]
<joelr> as 'a)
<joelr> Socket.t the variable 'a is unbound
<rproust> is your code available somewhere? part of it at least?
<joelr> let me check it in. hang on...
<joelr> see the poll branch
<joelr> i cannot check in the part that creates the sockets and sets up the poll set but that should be trivial.
<joelr> let me come up with an example you can use at the command line...
<rproust> btw, why do you use polymorphic variants for your phantom types?
<joelr> rproust: beats me. i thought that's what you were supposed to use. i certainly need variants and it looks like i need a type that can expand or shrink. e.g. to do this
<joelr> val streamer : [`Pull] Socket.t -> [`Push] Socket.t -> unit
<joelr> i thought you cannot do this with regular variants
<rproust> okay, you need polymorphic variants indeed
<joelr> err... do [<`Pull|`Sub] Socket.t
<joelr> right
<joelr> rproust: you should be able to build ocaml-zmq from my poll branch or at least get the same error that i'm getting
<joelr> sudo make reinstall
<joelr> will update the library at your findlib location
<joelr> if it builds that is :-)
<rproust> I have missing packages, I'm not on my personal machine right now, I cna't test the code
<joelr> missing packages ... hmm
<rproust> uint.uint64
<joelr> ah, yes, that one :( darn
<joelr> rproust: it should be easy to reduce that zmq code to a smaller example, though
<rproust> ZMQ.cmi cannot build…
<joelr> rproust: so you cannot install uint?
<rproust> I dont have root access on this machine
<rproust> I'll try later on an other machine
<joelr> rproust: you can findlib-install into ~/
<joelr> rproust: thanks
<joelr> rproust: i can try to reduce the whole thing to a page of code
<joelr> rproust: one more minute...
<joelr> I don't understand this, though: "File "zmq.ml", line 41, characters 15-16:
<joelr> Error: This expression is not a function; it cannot be applied
<joelr> "
<rproust> you may have forgotten a delimiter
<joelr> rproust: fixed the typo
<joelr> check again
<joelr> rproust: fixed again. now you get the error. https://gist.github.com/974321
jamii has quit [Ping timeout: 246 seconds]
<joelr> rproust: does that help? i'll be back in 30
<joelr> nope, still here
_andre has joined #ocaml
ygrek has quit [Ping timeout: 246 seconds]
vivanov has quit [Ping timeout: 276 seconds]
<joelr> fixed and compiles, except fails on the poll set
<joelr> thelema: are you around?
chegibari has joined #ocaml
<avsm> joelr: the declarations of the kinds are wrong
<avsm> val pair : [>`Pair] kind
<thelema> joelr: pong
<joelr> avsm: does it work when you change them?
<joelr> thelema: :^
<avsm> is correct: otherwise, the type of pair is restricted to only `Pair
<avsm> not tried, but it should
<joelr> avsm: funny, i just thought of asking you :D
<joelr> avsm: let me try...
<joelr> avsm: doesn't seem to make a difference
jderque has quit [Quit: leaving]
<thelema> joelr: are the kinds mutually exclusive? can a socket be more than one kind?
<joelr> avsm: what does [> 'Pair] kind mean?
<avsm> really? the same error?
<joelr> thelema: the socket can be of only 1 kind
<joelr> File "zmq.ml", line 83, characters 7-86:
<joelr> Error: A type variable is unbound in this type declaration.
<joelr> In type
<joelr> ([< `Dealer | `Pair | `Pub | `Pull | `Push | `Rep | `Req | `Router | `Sub ]
<joelr> as 'a)
<joelr> Socket.t the variable 'a is unbound
<avsm> post the new gist?
<joelr> sec
<joelr> type poll_socket = [<`Pair|`Pub|`Sub|`Req|`Rep|`Dealer|`Router|`Pull|`Push] Socket.t
<joelr> still complains about this
<avsm> you also changed that, why?
<avsm> that should be poll_socket = [], no <
<joelr> ah!
<joelr> avsm: you rule!
<avsm> np!
<joelr> avsm: so what does a kind of [> 'Pair] mean?
<avsm> covariant or contravariant
<joelr> can that be more than `Pair?
<avsm> to understand this, try
<avsm> let foo = function |`One -> () |`Two -> ()
<joelr> avsm: that's a closed type, right?
<avsm> the function can accept at least `One|`Two, or less (the extra matches are ignored). Any *more* and you get a match failure, so this is prohibited
vivanov has joined #ocaml
<joelr> avsm: so it's like "<" means less than
<joelr> and ">" is more than
<avsm> in your previous example, by saying "val pair: [`Pair]" you were restricting the type to be ONLY `Pair
<avsm> yeah
<joelr> avsm: well, [>`Pair] is a bit counter-intuitive because pair can only be `Pair
<joelr> how do i reason about that?
<avsm> no, by default it can be more: your type annotation was wrong
<avsm> do "let foo = `Pair"
<avsm> or rather, your type annotation was too specific
<joelr> avsm: does this mean that I can pass `Sub where only `Pair should be accepted?
<joelr> avsm: for example, val subscribe : [`Sub] t -> string -> unit
<joelr> I reason it depends on the typing of subscribe
<avsm> that will only accept a `Sub t
<joelr> e.g. if that typing (subscribe) allows pair than pair will "fit in"
<joelr> avsm: i think i'm coming to grips with this, thanks!
<joelr> avsm: do you think you can reply to the list, for future generations who will come searching?
<joelr> <- is happy as a clam
<avsm> feel free to post an answer: it's 6am in san francisco and i'm about to go for a run :-) later
avsm is now known as avsm^away
<joelr> avsm: will do, thanks!
<joelr> anyone?
<joelr> Error: The type of this expression, _[> `Pull ] ZMQ.Socket.t * _[> `Pub | `Pull ] ZMQ.Socket.t, contains type variables that cannot be generalized
<joelr> what's going on here?
boscop_ has joined #ocaml
boscop has quit [Ping timeout: 250 seconds]
boscop_ is now known as boscop
lamawithonel has joined #ocaml
<joelr> Requires [`Pull] ZMQ.socket for some reason, same for `Pub
oriba has joined #ocaml
<thelema> joelr: 'a is different from '_a, right?
<joelr> thelema: I have no idea. I'm just calling a function in the library
oriba has left #ocaml []
<thelema> okay, assume you have a module that exports a value of type ['a ref]
<joelr> yes
<thelema> this would be unsafe, as you could do [ x:= "foo" ] and then [ print_int (!x + 5) ]
<joelr> thelema: I have that error, btw, unless I stick the socket in question into type poll_socket = [`Pair|`Pub|`Sub|`Req|`Rep|`Dealer|`Router|`Pull|`Push] Socket.t
<joelr> Or remove > from [> `Pull]
<joelr> remove in the type definition for the socket I'm creating
<joelr> in my code, not in the library
<joelr> Of course if it's just [`Pull] then I cannot stick it into the poll set and I'm back to square 1
<joelr> thelema: so I'm doing something wrong here then, right? https://gist.github.com/974321
dnolen has joined #ocaml
<joelr> thelema: any suggestion on how to batten down the hatches?
<thelema> try using a cast to allow you to put it in the set -- (`Pull :> [> `Pull])
* thelema reads the gist
<joelr> thelema: hmm
<thelema> or bring pub and pull inside let poll_set
<thelema> let poll_set = let pub = ... in let pull = ... in of_poll_items ...
<joelr> hmm
<joelr> thelema: thanks
<thelema> non-functions can't be polymorphic as toplevel definitions
<thelema> basically because of the ['a ref] example above
<joelr> thelema: i'll have to internalize that
dnolen has quit [Client Quit]
<thelema> boscop: lol
<thelema> Proportion of true statements
<thelema> (more is better)
<thelema> lol
<boscop> "Resistant to Gödel attacks" :P
<boscop> "Can prove its own consistency" Yes
<thelema> It has come to our attention that several alternative operating systems such as "Linux" include a utility known as "/bin/true" which has been presented as a free, "open source" alternative to our Estatis Falso HyperVerifier program.
<thelema> I don't think they quite use their axiom correctly in their P=NP proof. where does the contradiction come from?
jamii has joined #ocaml
<thelema> I think Falso is broken, and they meant \forall P, P \Rightarrow \bottom
<boscop> thelema, from their assumtion that P != NP :P
<boscop> you can prove anything that way :P
<thelema> P \ne NP isn't a contradiction. And they haven't assumed that P=NP, which is what would contradict P \ne NP
<tomprince> The axiom of Falso implies a contradiction. In paricular you can show 'True' and 'not True'.
bzzbzz has quit [Quit: leaving]
<thelema> the axiom of falso is that you can conclude anything from a contradiction, which doesn't imply a contradiction
lamawithonel has quit [Remote host closed the connection]
<thelema> unless I'm misinterpreting \bottom
lamawithonel has joined #ocaml
bzzbzz has joined #ocaml
ymasory has joined #ocaml
jamii has quit [Ping timeout: 246 seconds]
ymasory has quit [Client Quit]
ymasory has joined #ocaml
ikaros has joined #ocaml
Associat0r has joined #ocaml
<tomprince> I think the axiom may be \bottom, not \forall P, \bottom -> P
<thelema> tomprince: ah, you're right. I assumed the large formula in the top right was the axiom. It does say "assuming contradiction as its only axiom".
joelr has quit [Quit: joelr]
<tomprince> I made them same mistake, until I realised that that formula was a theorem in any reasonable deductive system.
jamii has joined #ocaml
vivanov has quit [Ping timeout: 248 seconds]
vivanov has joined #ocaml
Associat0r has quit [Quit: Associat0r]
sgnb has quit [Remote host closed the connection]
sgnb has joined #ocaml
Rolands has quit [Read error: Operation timed out]
jderque has joined #ocaml
ftrvxmtrx has joined #ocaml
avsm^away has quit [Ping timeout: 240 seconds]
ftrvxmtrx has left #ocaml []
avsm has joined #ocaml
philtor has joined #ocaml
joewilliams_away is now known as joewilliams
hcarty has joined #ocaml
vivanov has quit [Ping timeout: 252 seconds]
avsm has quit [Quit: Leaving.]
ulfdoz has joined #ocaml
ulfdoz has quit [Read error: Connection reset by peer]
ulfdoz has joined #ocaml
ygrek has joined #ocaml
joewilliams is now known as joewilliams_away
<_habnabit> http://paste.pocoo.org/show/390035/ <- how is this ocaml code? I've been using this `match begin try .. end with ..` idiom a bunch.
<_habnabit> I'm trying to reduce the amount of code that's in the 'try' block.
joewilliams_away is now known as joewilliams
vivanov has joined #ocaml
<thelema> _habnabit: You might be able to use BatResult to clean this up a bit.
<_habnabit> Hm, is there an example of usage?
larhat has quit [Quit: Leaving.]
<thelema> Result.(catch (IntMap.find i) colors >>= (fun color -> ColorMap.singleton color 1, ColorSet.singleton color))
joelr has joined #ocaml
<thelema> Todo: Result.default : ('a, 'b) result -> ~def:'a -> 'a
<_habnabit> Oh neat.
<thelema> then you could chain a |> default ~def:(ColorMap.empty, ColorSet.empty) on the end and it'd do everything up to L13
<thelema> right now, the easiest way to do this is to go through Option.default
<_habnabit> Is Option in the stdlib, or is that batteries too?
<thelema> batteries
jamii has quit [Ping timeout: 246 seconds]
<_habnabit> Ah.
<thelema> hmm, why does Result.bind have a non-monadic type..
vivanov has quit [Ping timeout: 240 seconds]
<thelema> n/m, I expected bind to re-box the result of f
vivanov has joined #ocaml
alexgordon has joined #ocaml
ulfdoz has quit [Read error: Connection reset by peer]
<thelema> _habnabit: I just checked in some new functions into the result-extensions branch of github batteries. Using these functions, your code reduces to: Result.catch (IntMap.find i) colors |> Result.default_map (ColorMap.empty, ColorSet.empty) (fun c -> ColorMap.singleton c 1, ColorSet.singleton c)
<_habnabit> thelema, hah, wow
<_habnabit> thelema, that's pretty neat
ulfdoz has joined #ocaml
vivanov has quit [Ping timeout: 240 seconds]
vivanov has joined #ocaml
ygrek has quit [Ping timeout: 246 seconds]
vivanov has quit [Ping timeout: 241 seconds]
vivanov has joined #ocaml
lopex has joined #ocaml
vivanov has quit [Ping timeout: 264 seconds]
vivanov has joined #ocaml
vivanov has quit [Remote host closed the connection]
vivanov has joined #ocaml
lopex has quit [Ping timeout: 240 seconds]
vivanov has quit [Ping timeout: 276 seconds]
joelr has quit [Quit: joelr]
schme has quit [Ping timeout: 260 seconds]
schme has joined #ocaml
avsm has joined #ocaml
avsm has quit [Client Quit]
schme has quit [Ping timeout: 246 seconds]
schme has joined #ocaml
schme has quit [Changing host]
schme has joined #ocaml
smerz has joined #ocaml
lamawithonel has quit [Remote host closed the connection]
lamawithonel has joined #ocaml
jderque has quit [Quit: leaving]
jld has quit [Ping timeout: 260 seconds]
Snark has quit [Quit: Ex-Chat]
impy has quit [Ping timeout: 276 seconds]
_andre has quit [Quit: Lost terminal]
_andre has joined #ocaml
neruda has joined #ocaml
neruda has left #ocaml []
olauzon has joined #ocaml
ymasory has quit [Quit: Leaving]
impy has joined #ocaml
jld has joined #ocaml
chegibari has quit [Ping timeout: 260 seconds]
oriba has joined #ocaml
Cyanure has quit [Remote host closed the connection]
lopex has joined #ocaml
avsm has joined #ocaml
_andre has quit [Quit: leaving]
schme has quit [Ping timeout: 241 seconds]
schme has joined #ocaml
schme has quit [Changing host]
schme has joined #ocaml
avsm has quit [Quit: Leaving.]
Associat0r has joined #ocaml
avsm has joined #ocaml
avsm has quit [Client Quit]
schme has quit [Ping timeout: 276 seconds]
Associat0r has quit [Quit: Associat0r]
edwin has quit [Remote host closed the connection]
schme has joined #ocaml
waern has quit [Quit: Lost terminal]
oriba has left #ocaml []
schme has quit [Ping timeout: 246 seconds]
schme has joined #ocaml
ikaros has quit [Quit: Leave the magic to Houdini]
philtor has quit [Ping timeout: 276 seconds]
smerz has quit [Quit: Ex-Chat]
hto_ has joined #ocaml
hto has quit [Ping timeout: 252 seconds]
Amorphous has quit [Ping timeout: 246 seconds]
Amorphous has joined #ocaml
boscop has quit [Ping timeout: 246 seconds]
lopex has quit []
boscop has joined #ocaml
dnolen has joined #ocaml
boscop_ has joined #ocaml