<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
<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>
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>
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
<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.
<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]