dark_light changed the topic of #ocaml to: OCaml 3.09.2 available! Archive of Caml Weekly News: http://sardes.inrialpes.fr/~aschmitt/cwn/ | A free book: http://cristal.inria.fr/~remy/cours/appsem/ | Mailing List: http://caml.inria.fr/bin/wilma/caml-list/ | Cookbook: http://pleac.sourceforge.net/
redacted has joined #ocaml
malapropism has quit [Read error: 113 (No route to host)]
postalchris has quit [Read error: 110 (Connection timed out)]
triple_ has quit [Read error: 113 (No route to host)]
<dark_light> anyone has a ocaml event tutorial? i tried to learn this before but it's too confuse
<dark_light> or at least a better documentation than the library reference
clog_ has joined #ocaml
clog has quit [Read error: 110 (Connection timed out)]
clog_ is now known as clog
yip has quit [Read error: 110 (Connection timed out)]
yip has joined #ocaml
Payo543 has joined #ocaml
<Payo543> yo yo whats up
<Payo543> has been like 3-4 weeks since i worked on that jabber client
<Payo543> i will finish it soon
Demitar__ has joined #ocaml
mattam has quit [Read error: 104 (Connection reset by peer)]
mattam has joined #ocaml
Demitar_ has quit [Read error: 110 (Connection timed out)]
chessguy has joined #ocaml
<abez> names
<abez> crap
<abez> dark_light: perhaps you should try to come up with some questions then perhaps we can answer them. Perhaps your questions are more ocaml related than library related
<dark_light> abez, what you meant by "come up"? (i am not a native speaker ^^)
<abez> dark_light: create some questions.
<dark_light> abez, well my problem with Event is: seems nice to treat threads in the code as processes that are sending messages to each other, and ocaml take care to translate it in terms of shared memory (that's what i understand from the Event module) but i don't figure how to create a working example
<dark_light> abez, i don't know very much of ocaml, but i understand what means the signatures explained at the library reference, but i still don't get it
levi_home has quit [Read error: 128 (Network is unreachable)]
pango__ has joined #ocaml
levi_home has joined #ocaml
pango_ has quit [Remote closed the connection]
chessguy has quit [" HydraIRC -> http://www.hydrairc.com <- Leading Edge IRC"]
Smerdyakov has quit ["Leaving"]
<abez> dark_light: did you find a tutorial?
<dark_light> abez, actually no, i searched a bit and then put it in a 'postit'
<dark_light> thanks:)
<abez> dark_light: and I wrote this just for you (because I didn't know anything about Event before)
<abez> ocamlc -vmthread /usr/lib/ocaml/vmthreads/threads.cma /usr/lib/ocaml/vmthreads/unix.cma events.ml ocamlc -vmthread
<abez> ocamlc -vmthread /usr/lib/ocaml/vmthreads/threads.cma /usr/lib/ocaml/vmthreads/unix.cma dark_light_example.ml
<abez> I used that to compile it
<abez> ocamlc -vmthread -I vmthreads threads.cma unix.cma events.ml
<abez> that worked too
<dark_light> thanks a lot :)
llama32 has joined #ocaml
<abez> so
<abez> you could batch up a bunch of events
<abez> then select on them or poll them
<dark_light> wow :o first setep to try to understand it: removing the open things
<dark_light> because i don't know anything of Thread or Event modules, i get a lot of confusion about this
<dark_light> magic :o
<dark_light> i have only question (i hope), why in the odd sends the receiver is echoing first, and in the pair sends the sender is echoing first? like http://paste.ubuntubrasil.org/795 , it's random and just coincidence?
<dark_light> i would think that if the threads is being syncronized, the receiver would ever echo after the sender
<abez> IO is funny like that
<abez> I was using endline but there is no real guarantee on the order
<dark_light> i changed to Printf.printf "SENDING %d\n%!" !i , but it's the same thing
<dark_light> abez, very very nice your code:)
malapropism has joined #ocaml
<abez> also when you sync
<abez> you might switch thread contexts
<abez> so then the other thread runs, gets the value and prints and leaves
<Payo543> anyone here ever use mod_ocaml ?
<abez> no :|
<Payo543> i seee
<dark_light> i plan to use someday, heh:)
<dark_light> let f () = let i = ref 0 in incr i; !i;; anyone knows why this doesn't work? someone here wrote a little "global counter" like this, but this is returning 1 ever
<Payo543> don't ref incriment or something ?
<abez> because you make a new i every time
<dark_light> abez, the function of that person made some trick to make the i one 1 time
<dark_light> Payo543, the ref is incrementing, but only 0 to 1 ever
<abez> let f = let i = ref 0 in (fun () -> incr i; !i) ;;
<Payo543> well what should be stored in ref's normally ?
<dark_light> wow, :o
<dark_light> Payo543, a global counter
<abez> dark_light: see I used a closure there
<Payo543> hmmm
<abez> better layout: let f = let i = ref 0 in (fun () -> incr i; !i)
<abez> ;;
<abez> crap
* abez kicks irssi
<Payo543> i havent used any refs so far in my jabber client
<abez> that's a good start :|
<dark_light> abez, Hmmm.. ocaml generally behaves in a odd way I generally don't understand
<abez> dark_light: well read the tutorials about let etc.
<abez> dark_light: let is like let in math
<abez> let a = value in the following
<abez> in ocaml you just go let a = value in
<dark_light> abez, all tutorials i found never mentioned that, hmm, oddities
<abez> say it outloud
<dark_light> abez, why using a closure avoids creating the variable all times i call the function? it's not very obvious for me :(
<dark_light> hm
<abez> ok first I said make i which is a ref to 0
<abez> then I said make a function which increments and returns i
<abez> then I let f = that function
<abez> I assigned (fun () -> incr i; !i) to f, i was just a intermediate value which will persist for the life of the function
<dark_light> Hmmmmm..
<dark_light> so in let f () = let i = ref 0 in incr i; !i the "i = ref 0" is part of the function, and in let f = let i = ref 0 in (fun () -> incr i; !i) it's not part of the function?
<abez> oh wrt to threads and printing here's another example http://churchturing.org/w/dark_light_example.ml
<abez> ( I updated it )
<dark_light> abez, i think ocaml lib should come with the loop and the count functions, they are very useful. and the identity function too.
<dark_light> maybe in ocaml 4?=)
<dark_light> who knows..
chessguy has joined #ocaml
<abez> pretty easy to define :| but I agree it'd be nice if ocaml came with some module called messy which did little short cuts you always reimplement
<abez> anyhoo
<abez> let i = ref 0 in said let i be a reference for all the following expressions
<abez> and the next expression was (fun () -> incr i; !i)
KzzchX has quit ["Snak 5.1.5 IRC For Macintosh - http://www.snak.com"]
<abez> i be an integer reference usable in the following expressions
<abez> then the actual return value of the expression let i = ref 0 ( fun () ... ) was the function
<abez> then that gets assigned to f
<dark_light> Hmmm
<abez> think of it like
<abez> let f =
<abez> let i = ref 0 in
<abez> (fun () -> incr i; !i)
<abez> (fix indentation)
<dark_light> abez, many Pervasives functions are pretty easy to define.. like the min, max, fst, snd.. it's just a matter to padronize the obvious things
<abez> eh all the easy stuff is easy, it is the hard stuff you should be worried about
<dark_light> :)
<dark_light> i like to have standard ways, that's what i am saying=)
<abez> I'm not saying ocaml isn't missing a whole bunch
<abez> I always implement a list_iteri list_mapi list_fold_lefti, mapn, foldn, itern
<abez> then I grab other libs to deal with binary encodings of values
redacted has quit [Read error: 113 (No route to host)]
<dark_light> hmmm
<dark_light> abez, but why?
<dark_light> there is a List.iteri in ocaml lib, isn't?
<dark_light> wow, isn't
<abez> yeah :(
<abez> but it is easy to make
chessguy has quit [" HydraIRC -> http://www.hydrairc.com <- IRC has never been so good"]
<dark_light> do you know how can i make send_to_printer use a printf-like syntax style? i am trying to do it with Printf.sprintf but it's becoming hard
<dark_light> i don't want to use send_to_printer (Printf.sprintf "Sending %d" !i), i would like to do send_to_printer "Sending %d" !i
llama32 has quit [Read error: 131 (Connection reset by peer)]
<dark_light> i always wanted to know what kind of dark magic Printf uses..
<dark_light> wow, aparenttly let print pattern string = Printf.sprintf pattern string;; works, hmmm.. that's nice..
<flux__> dark_light, but that doesn't work in the general case
<dark_light> apparently the string is expanded to fit all parameters, or just is ignored..
<dark_light> flux__, don't works?
<dark_light> # print "%d";;
<dark_light> - : int -> string = <fun>
<dark_light> # print "%d%d";;
<dark_light> - : int -> int -> string = <fun>
<dark_light> seems to work
<flux__> dark_light, let f fmt = Printf.ksprint (fun s -> Printf.printf "this works always: %s\n" s) fmt
Skal has joined #ocaml
<dark_light> Printf.ksprint
<dark_light> ?
<flux__> or krpintf if you have an older ocaml version
<dark_light> here ksprintf is in Format
<flux__> I haven't used format, but I guess it is suitable too
chessguy has joined #ocaml
<flux__> they are different functions, they work on different types
<dark_light> flux__, the problem was ksprint instead of ksprintf :)
<flux__> oh, right
<dark_light> flux__, but i didn't got why you said that would not work in general case
<dark_light> Printf.sprintf uses format .. that function you passed uses format4 type, i don't know the difference
<flux__> your function wont work with both "%d" and "%s", for instance
<flux__> well, actually, it might
<flux__> but not with "%s%s"
<dark_light> print "%s%s";;
<dark_light> - : string -> string -> string = <fun>
<flux__> what is print?
<dark_light> let print pattern string = Printf.sprintf pattern string
<flux__> hm
<dark_light> the "string" parameter is only a dummy parameter i think.. maybe it could even be removed
<dark_light> actually i could write let print = Printf.printf .. heh
<flux__> oh, right. I was thinking of a function where you actually use the value somehow.
<dark_light> flux__, ah. in that case, how could i separe the values?
<flux__> in those cases you need ksprintf
<dark_light> flux__, and keep the generic behaviour of printf?
<flux__> yes
<dark_light> Hmmmm
<dark_light> f "test: %d" 1 -> this works always: test: 1
<dark_light> how can i recover the "1" passed to f?
<flux__> you can't
<flux__> you can recover only the generated string
<flux__> ocaml in general doesn't support variable number or dynamically typed arguments
<flux__> so it's all built in into handling formatting strings and doing outputting
<dark_light> :(
<dark_light> flux__, in lisp this can be constructed in the language itself, right?
<flux__> yes
<dark_light> :(
<flux__> lisp doesn't give static type guarantees, though
<dark_light> flux__, but it's using what, macros?
<flux__> I don't think it needs to use anything special
<flux__> just take the string and variable number of arguments
<dark_light> wow, why?
<flux__> I think there are examples of doing something similar in pure sml, which I believe could be ported to ocaml
<dark_light> flux__, i think defun itself is implemented in lisp but i don't know many about lisp
<dark_light> (uh.. know many about lisp, this might sounds ugly:)
<flux__> I suppose that might be possible, because the lisp interpreter itself can be written in lisp
<dark_light> that doesn't say many things, a brainfuck interpreter can be written in brainfuck :-P
<dark_light> hey, when i type let printer_call pchan pattern param = Event.sync (Event.send (Printf.sprintf pattern param)) , ocaml says This expression has type 'a -> unit Event.event but is here used with type 'b Event.event
<dark_light> :(
<dark_light> ah, hm
<dark_light> the correct might be let printer_call pchan pattern param = Event.sync (Event.send pchan (Printf.sprintf pattern param))
malapropism has quit [Read error: 113 (No route to host)]
<dark_light> http://paste.ubuntubrasil.org/796 , i was afraid of it.. someone has a idea how to make the types compatible?
<dark_light> hmm.. trying to use ksprintf..
malapropism has joined #ocaml
llama32 has joined #ocaml
chessguy has quit [" Want to be different? HydraIRC -> http://www.hydrairc.com <-"]
<abez> well the types just aren't compatible
<abez> format != string
<dark_light> abez, but i am trying to carry a format to printer_call and then transform this format into a string and then pass as an event
shawn has quit ["This computer has gone to sleep"]
<abez> why not just do the sprintf before you send the value
<dark_light> abez, this is ugly
<abez> Well I rarely use Printf for reasons like this
<dark_light> but this simply doesn't makes sense"
<abez> yeah it does
<abez> A. printf doesn't follow the rules
<dark_light> let print a b = Printf.fprintf a b, this will cause printf "Test%d" integer a sucess
<abez> B. printf is a bit of a hack
<abez> C. types get very confused
<dark_light> abez, why could this be a sucess and that function not?
<dark_light> s/why/how/
<dark_light> the "limits" of ocaml is very odd and ugly :-(
<abez> well your fprintf examples needs an outchannel
<dark_light> i am using sprintf
<abez> Printf is hack. Ocaml is statically typed.
<abez> The fact you can take multiple arguments for a sprintf or a printf shows that it is a hack.
<dark_light> abez, but it must work! :(
<abez> Your formats have to be static
<dark_light> abez, but sprintf always end to a string
<abez> the pattern is a format
<abez> not a string
<abez> that is the hack
<dark_light> (or maybe not, if i include less parameters than nedeed)
<abez> # let a = " %d " ;;
<abez> val a : string = " %d "
<abez> # Printf.printf a 0;;
<abez> This expression has type string but is here used with type
<abez> ('a -> 'b, out_channel, unit) format =
<abez> ('a -> 'b, out_channel, unit, unit) format4
<abez> a is a string
<abez> not ('a -> 'b, out_channel, unit) format
<dark_light> abez, can i make ("literal" : format) ?
<dark_light> well, Format.format i think
<dark_light> *trying*
<dark_light> The type constructor format expects 3 argument(s),
<dark_light> but but but.. why "a" can be accepted as a format, but ("a" : format) not? maybe the format is ("%d" 1 : format). hmmm..
<dark_light> :o
<abez> # let p (pat:(('a -> 'b, unit, string, string) format4)) other = Printf.sprintf pat other ;;
<abez> # let p (pat:(('a -> 'b, unit, string, string) format4)) other = Printf.sprintf pat other ;;
<abez> val p : ('a -> 'b, unit, string) format -> 'a -> 'b = <fun>
<abez> # p " %d " 1;;
<abez> - : string = " 1 "
<abez> # p " %s " "lol";;
<abez> - : string = " lol "
<dark_light> Hmmm
<abez> so we're telling ocaml what type to expect
<abez> so it'll match it
<abez> (printf is a hacky >:( )
<abez> So ocaml decides if your lonely string is a format or a string :|
<dark_light> ("a" : ('a, unit, string) format), works..
ramki has quit [Read error: 104 (Connection reset by peer)]
<dark_light> abez, i think ocaml should have been designed like lisp.. i don't like to know there are things in language that can't be written in the language itself, except the most basic things
<abez> It isn't and won't be :|
<abez> It is statically typed.
<abez> There is a huge difference.
<dark_light> abez, i don't even mind why
<abez> It defeats the purpose of ocaml to have weak typing
<dark_light> weak typing?
<dark_light> like lisp?
<dark_light> why the static type discipline can't lead to a "code is data" or something like this? i don't know why ocaml must be dynamically typed to be like lisp..
<abez> you have first order functions.
<dark_light> abez, in lisp too. well, i think. (i don't program in lisp)
<abez> List.map (+ 4) [1 ; 2; 3]
<abez> you can't curry in lisp
<abez> easily
<dark_light> abez, Hmmmmmm? so you confused me :)
<abez> (+ 4) in lisp is 4
<abez> (+ 4) in ocaml is fun a -> 4 + a
<dark_light> in ocaml is a syntax error (eheheh)
<dark_light> but, hmm
<dark_light> abez, there is a special reason to lisp don't have currying?
<abez> because it variable length arguments
<abez> it would be impossible to tell if you are currying
<abez> your function could have some logic to detect hey I want 3 but have 2
<abez> but it isn't always feasable
<dark_light> hmmmmmmmmmmmmmm
<abez> ok the operator example was bad
<abez> but I could go let add a b = a + b in
<dark_light> abez, i got it
<abez> and then (add 4)
<abez> List.fold_left ( * ) 1 [ 1; 2 ; 3];;
<abez> that works but no currying
<dark_light> but list has a function that makes currying..
<dark_light> lisp
<dark_light> (function something), i don't know
<abez> yah
<abez> you do it explicitly
<abez> but ocaml is statically typed
<abez> it tells you when you do something semantically wrong
<abez> lisp has crap all for semantic checking
<dark_light> Hmm.. the function types have to be dynamic to accept variable lenght arguments, that's what you are saying?
<abez> # let f = function Some(x) -> true ;;
<abez> Warning: this pattern-matching is not exhaustive.
<abez> Here is an example of a value that is not matched:
<abez> None
<abez> val f : 'a option -> bool = <fun>
<abez> see ocaml was able to check and say HEY if someone passes a None to you, you fall apart.
<abez> dark_light: no it just isn't really done in ocaml and it messes with currying if you don't know how many args a function has.
<abez> dark_light: you're welcome to write some macros in camlp4 which do what you want
<abez> dark_light: generally camlp4 is the best way to break the rules
<dark_light> :)
<abez> but you shouldn't break the rules til you really need to
<abez> of course when one needs to is totally a personal decision
<abez> and thus arbitrary
<dark_light> abez, it's sad to hear that a language with safety typing like ocaml can't have the flexibility of lisp, i still can't accept it :P
<abez> you don't code in lisp
<dark_light> maybe when i learn lisp i would understand..
<abez> I use ocaml and perl. I use perl for flexibility and ocaml for speed and clarity
<abez> And perl modules
<abez> Perl is great for anything less than 10kloc
<abez> but once you hit a reasonably complex and large program perl starts to stink and you need to really design things right.
redacted has joined #ocaml
<abez> Even then you can't get the speed you get out of ocaml from perl (without a tonne of C)
<abez> Ocaml has a buttload of problems with it. But it still works great. Common Lisp is no where near the speed I need :|
<dark_light> i know what is this.. i learned how to program with a incredible bad language, mirc scripting, used to script a irc client for windows.. it has no consistency at all
<dark_light> it is a bit like shell scripting, that i use as a "mirc scripting done right".. and maybe like perl, but i don't know many things of perl
<dark_light> (comparing it with shell scripting might be like an heresy, it has no unix tools :)
<abez> You use ocaml when you want a flexible language that is typesafe, garbage collected and fast.
ramki has joined #ocaml
<dark_light> actually i use ocaml when i need a program that is a bit complex and shell scripting to simple things, that's it
<TFK> Before talking about speed, ask yourself how easy it is to build an RSS feed or an IRC client with nothing but the stdlib.
<dark_light> TFK, writing a irc client, that is a thing i was trying to do before with objects
<abez> Try doing a FFT in perl or java
<dark_light> i tried to build a object "connection" and functions to handle externally this object, but the type system failed, like my current problem with printf
<dark_light> abez, FFT?
<TFK> How did it fail?
<abez> Fast Fourier Transform
<abez> The typesystem didn't fail
<TFK> Well, FFT isn't as useful as an RSS feed.
<abez> you were relying on formats but using strings
<abez> >:( I have work to do.
<dark_light> abez, well i might be failed too, but it was really odd
<TFK> Or should I say, is less common in desktop land.
<dark_light> abez, o/ bye, and thanks for the help!
<abez> I use ocaml for computer audio, computer vision, number crunching and stats.
<dark_light> TFK, i will search here the code, but i gived up, i will try someday a functor-based approach.. :(
<TFK> dark_light, can you paste the code into a pastebin?
<dark_light> yes
<abez> all he needs is some format type hints
<abez> TFK: the stdlib is very tiny. You would have to get external modules to do that. Just like in Perl and other languages.
<TFK> abez, one would expect to at least have Unicode as part of the package.
<abez> People said the same of Ruby too :(
<abez> I think INRIA needs to include more things
<abez> unicode is a good candidate
<TFK> As for "other languages", see the .NET Framework. As for myself, I come from Python, which may have a bloated stdlib, but it does the job.
<abez> Python is a 27mb tar ball of source code
<TFK> ^_^
shawn has joined #ocaml
cthulachu has joined #ocaml
<abez> It'd be nice if there was that library availability for ocaml
<abez> I find myself writing too many bindings
<TFK> py2exe'd stuff only take ~2 MBs :-P
<abez> Hey I've compiled python from source, it is pretty brutal, don't get me started.
<TFK> Why did you compile from source?
<abez> Because I have older systems
<abez> No package management
<abez> or I needed a new python
<TFK> Sadness :-(
<TFK> On the plus side, to get things working you usually only need the source.
<abez> The library availability is why I use perl for things for web automation
<abez> PCRE in ocaml is nice tho
<TFK> What's that?
<abez> Perl's Regexes
malapropism has quit [Read error: 113 (No route to host)]
<abez> Just about everything you do m/ or s/ is handled by PCRE
<abez> and the interface is ok
<abez> even php uses PCRE
<abez> (probably a bunch of functions named pcre_)
<TFK> I'm not sure if that's something to be proud of :-P
<abez> Well ocaml's C interface is relatively clean
<abez> sure it isn't common lisp's dll loading
<abez> but it is pretty usable.
<TFK> Hmmm. There's a lot of "OK" and "usable" in your rhetoric, but no "great" or "excellent", not very encouraging ;-)
<dark_light> TFK, well i am not finding the bug, now all is compiling smoothly.. o.O
<abez> TFK: well go look at how common lisp deals with dlls
<TFK> dark_light, next time you have a bug you can't solve yourself, make a minimal example that people can run standalone, and paste it in a pastebin. People get very touchy when you imply their favourite langauge doesn't work ;-)
<TFK> I suppose it just loads them out-of-the-box?
<abez> You bind names to symbols inside of common lisp
<abez> no C muckery
<dark_light> TFK, but in that time i had a code in pastebin
<dark_light> TFK, and only a guy who hates objects was reading my message:)
<dark_light> ahh i just commented the error code and returned unit instead :)
<TFK> dark_light, can you repaste the link?
<TFK> abez, and it does all the GC magic itself?
<abez> TFK: I assume so.
<TFK> Cool :-)
<dark_light> TFK, there is only a problem: it uses micmatch camlp4 extension to do pcre regex matches in a nice way
<TFK> You mean you extended OCaml's syntax?
<dark_light> yes
<dark_light> i could do it with Str module, but seemed too ugly
<dark_light> it inherits from a Net module, i will past it too.. well well
<dark_light> that's my net module http://paste.ubuntubrasil.org/798
<TFK> Seems too advanced for me already ^_^;;
<dark_light> TFK, i wish i could explain it simply but i forget the code ahahaha, but hmm
<TFK> Did you paste all the code? I don't see line 66 there
<dark_light> TFK, that incoming function receives a connection and passes it to auxiliary functions, that uses the privmsg and list_autojoin methods itself
<dark_light> ah well lol
<dark_light> the code is wrong
* dark_light very confused
<TFK> And, as I said earlier, reproducing the code in a small example often reveals the bug.
redacted has quit [No route to host]
<dark_light> TFK, i can't reprocude because it don't compile
<dark_light> TFK, but, hmm.. small piece of code
<dark_light> TFK, i might try, but i don't remember exactly why the type system said i am wrong
<abez> dark_light: if you're calling methods which aren't found in your class it will not compile
<dark_light> abez, well it is
<dark_light> privmsg and list_autojoin are methods of my class
<TFK> But incoming isn't.
<abez> Oh I remember
<abez> you have to upcast
<TFK> But, shouldn't it be seen "globally" in the module?
<dark_light> TFK, the idea in my code is: creating a connection that autoconnect and then when receive the "end of motd" condition, join the channels i specified, and when receive a message, try to reply with "bah"
<dark_light> TFK, it is
<dark_light> abez, upcast?
<TFK> (Doing explicit type annotation also helps reasoning.)
<TFK> dark_light, apparently OCaml doesn't upcast child classes to their parents automatically.
<abez> let wl = (l :> widget) :: wl;;
<dark_light> what is upcast?
<abez> It is a generalization
<TFK> Ooops, gotta go. See you in a few days!
TFK has quit []
<abez> dark_light: in your incoming
<abez> for receiver
<abez> for (receiver :> toplevelclassnamekthxok)
<dark_light> abez, where should i use this coercion? (and, i have never used :> before, let's check what coercion really means.. :P)
<abez> dark_light: inside of incoming will probably work
<abez> let receiver = (receiver :> toplevelclassnamekthxok) in
<abez> you can do it when you pass it in as well
<dark_light> but you are saying that i must coerce to the parent, or the child? i am getting confused :P
<abez> child -> parent
<abez> specialize -> generalize
_velco has joined #ocaml
bebui has quit [Read error: 131 (Connection reset by peer)]
<dark_light> abez, let me think if i got it. you said i can do incoming (self :> Net.connection) msg instead of doing incoming self msg?
<abez> if self inherits from Net.connection then yes
<dark_light> incoming function uses specialized methods of IRC.connection
<abez> Then use IRC.connection
<abez> what do you specialized?
<abez> They don't appear in Net.connection?
<abez> Or they do?
<dark_light> join, list_autojoin and privmsg
<dark_light> they don't appear in Net.connection
<dark_light> hey
<abez> and self will be an IRC.connection
<dark_light> incoming (self :> connection) msg
<dark_light> compiled
<dark_light> and it is ODD
<dark_light> because self is *suposed* to be of the type of the class..
<abez> it doesn't change the value
<abez> you're just telling ocaml how you think you're going to use it
<dark_light> abez, but ocaml can't figure out this?
<dark_light> because i declared self in object (self)
<dark_light> inside the class connection
_fab has joined #ocaml
<abez> type inference has its limitations
<abez> there's a good mathematical reason behind it
<abez> (except it sucks)
<dark_light> abez, the "middle and common" of type inference in ocaml is very beautyful
<dark_light> but the border is ugly and painful :(
<abez> it saves your ass
<abez> Think of it as thousands of assertions being run before you even run the program.
<dark_light> abez, it sucks when you figure out that the "genial" way you are doing the things simply can't work
<dark_light> abez, in C you know when a thing can't work (well, in mostly cases). in ocaml is harder to tell, because ocaml is odd
<abez> that's just because you are used to C
<abez> C does very little real type checking
<abez> and most people turn a blind eye to type checking warnings and errors in C
<abez> a (void *) thrown in nullifies type information and it just trusts you
<dark_light> abez, i mean: the way ocaml treat types is difficult to predict without extense knowledge in that specific fields
<dark_light> it's not very "generic" in the details
<abez> ocaml is academic
<dark_light> it's a bad thing to have in a functional language
<abez> uh I suggest you go do research on what functional programming means before you say stuff like that.
<dark_light> oh :)
<abez> functional programming is VERY academic
<abez> Ocaml is sorta weird but so is haskell
<abez> and most of other functional languages
<abez> ugh
<abez> late
<abez> bed
<abez> nite
<dark_light> abez, maybe i can't express myself, i was trying to retype what i said and i still can't find the words :P ocaml is odd, but i don't mean that ocaml is a bad language, just that it behaves in some specific topics in a way that could be better
<abez> a lot of that is dictated simply by mathematics
<flux__> I think ocaml was a project to have a language that would be usable in "the real world" ;=
<flux__> ;) even
<dark_light> what is your definition of "functional programming"? for me it leads to very generic approaches for the problems it solves..
<dark_light> i think ocaml should have a mecanism of "meta language" to define the things like "let", "match",
<dark_light> not camlp4, in ocaml itself
<dark_light> maybe i am saying very random things, but, i think that ocaml could be more consistent, that is :P
slipstream has joined #ocaml
pango__ has quit [Remote closed the connection]
slipstream-- has quit [Read error: 110 (Connection timed out)]
<dark_light> a question about oo: can i make a initializer that executes *before* the parent initializer?
pango has joined #ocaml
<flux__> I think a camlp4-mechanism is perfectly suitable for making language extensions, because it partially discourages making the language very different due to little things :)
<flux__> dark_light, maybe you mean class foo () = let a = 42 in object method get_a = a end;; ?
<flux__> (new foo ())#get_a;;
<dark_light> Hmmm that's because i have a generic connection that can (optionally) have a autoconnection and a irc connection that must register it "on connect function" to do basic login *before* the parent code tries to autoconnect
<dark_light> for now turned off the autoconnect and am connecting later, to make sure the on connect is registered before i try to connect
<flux__> well, I think there's a suitable type-safe mechanism, if I'm getting your problem properly
<flux__> so you could have your connect-method to require it gets a parameter of type connected
<flux__> or actually, registered
<flux__> and the register-function returns 'registered'
<flux__> I suppose that isn't completely fool proof though
<flux__> actually I don't think I understand your problem :)
llama32 has quit ["Leaving"]
<dark_light> Hmm, you gave me a idea, the connect parameter may receive the on connection function
<dark_light> flux__, but my problem was: the parent has a val mutable on_connect_hook = on_connect, and the on_connect is defined as ?(on_connect=(fun x ->())). this function is called whenever i connect so it must be registered before the connection
<dark_light> but i can't pass the function by parameter to the class because it uses methods of this class
<dark_light> but wait.. maybe i can pass it..
<flux__> you can pass stuff to constructors like: class foo on_connect = object val mutable on_connect_hook = on_connect end;; new foo (fun () -> Printf.printf "Jei\n")
<flux__> I don't know if you were aware of that already, though :)
<flux__> maybe that's just the mechanism you're using
<flux__> I haven't used objects much in ocaml
<dark_light> flux__, but my problem is: the "on_connect" must use methods from the object
<dark_light> maybe i should call the on_connect with the object as parameter
love-pingoo has joined #ocaml
<dark_light> anyone knows how can i do a "select" with the channels at pervasive? i want read from stdin but do not block my other things, so i can read for some seconds and then do other things in my loop
<flux__> you must use either threads or Unix.read/write/select
redacted has joined #ocaml
lichtblau has joined #ocaml
cthulachu has quit [Read error: 113 (No route to host)]
<dark_light> how can i generate a .cmi file? generally it's generated automatically here.. when i changed a class the compiler said that the .cmi is wrong so i deleted it and now it says "Could not find the .cmi file for interface net.mli."
lichtblau has left #ocaml []
<flux__> you can compile net.mli to net.cmi
<dark_light> well i tried ocamlc -o net.cmi net.mli and didn't work.. but i think i found it
<dark_light> it was -package
<dark_light> Err wasn't
<dark_light> it should be -pack but isn't working
<dark_light> here -pack says: Build a bytecode object file (.cmo file) and its associated compiled interface (.cmi).. can't i combine -pack with -a?
<dark_light> ... well, ocamlc -o net.cmi net.mli just works..
<flux__> ocamlc -c foo.mli
<dark_light> :)
<knobo> I made a small test application that uses the Graphics module, and it was supprisingly slow...
<pango> care to paste it on some site ?
<knobo> I can do that
<knobo> formating dissapered
<knobo> maybe it's only a dubble buffer issue
bluestorm has joined #ocaml
<pango> speed varies between runs :/
<knobo> yes
<knobo> very strange
<knobo> I also tried with ocamlopt
<knobo> ocamlopt graphics.cmxa fire.cmx -o fire.bin -cclib -lgraphics -cclib -L/usr/X11R6/lib -cclib -lX11
<pango> uuuh just graphics.cmxa should do
<pango> since ocaml 3.04 or so
<pango> using images seems to help... I suppose the problem is the number of drawing primitives that get sent to the X server
dark_light has quit ["Ex-Chat"]
Snark has joined #ocaml
<pango> well, double buffering alone is almost as good... probably for the same reason
<knobo> yes, that what I thought. I had the understanding that ocaml is fast.
<knobo> Now it is good enugh. Now I'll make some real fire :)
<knobo> is it possible to make the flickering go away (using -images)
<pango> tried the double buffering ?
<knobo> yes, it works.
<knobo> I'm not clear on how the double buffering works here.
<knobo> syncronize just waits until it is finnished drawing?
<pango> there's two buffers (as the name implies), one in X server display, and one "client side"
<knobo> this I know
<pango> when auto_synchronize is enable, both are updated simultaneously
<pango> when it is disabled, only the client side buffer is modified, and you use synchronize to "commit" the buffer to X
chessguy has joined #ocaml
<pango> (probably as a single pixmap transfer)
ziggurat has quit ["Leaving"]
ziggurat has joined #ocaml
chessguy has quit [Connection timed out]
ikaros has quit [Read error: 60 (Operation timed out)]
<knobo> I love languages where you can be creative from the first second :)
<knobo> Probably because of my Amiga background, where you could program gui application in assembler...
<yip> nothing is more creative then "Hello World!"
ikaros has joined #ocaml
buluca has quit ["Leaving."]
ikaros has quit [Remote closed the connection]
ikaros has joined #ocaml
<knobo> "hello world" applications kills my motivation
two-face has joined #ocaml
<two-face> Hi
malapropism has joined #ocaml
ramki has quit [Read error: 110 (Connection timed out)]
_velco has quit [Read error: 145 (Connection timed out)]
ramki has joined #ocaml
redacted has quit [Read error: 113 (No route to host)]
duncanm_ has joined #ocaml
duncanm has quit [Read error: 110 (Connection timed out)]
chessguy has joined #ocaml
redacted has joined #ocaml
malapropism has quit [Read error: 113 (No route to host)]
<knobo> two-face: hi
<knobo> :)
chessguy has quit [" HydraIRC -> http://www.hydrairc.com <- Go on, try it!"]
pango has quit [Remote closed the connection]
<two-face> bye
two-face has left #ocaml []
<ikaros> hi folks, im new to ocaml. i wanted to ask if there is any printed book available for ocaml? i browsed amazon but couldnt find one
Leonidas has joined #ocaml
<eradman> The only book that I'm aware of is "Objective CAML for Scientists"
<eradman> Expensive
two-face has joined #ocaml
<two-face> has anyone already used xmllight?
<ikaros> eradman, thx but i think this isnt the right book for an ocaml newbie?!
<ikaros> well i guess i will stick to the only books for now
<ikaros> online i meant
<eradman> That's what I've been doing
<two-face> alright, fixed my pb with xmllight
<bluestorm> ikaros:
<bluestorm> hum, nothing :-°
<ikaros> eh ? =)
<bluestorm> (i thought of http://caml.inria.fr/pub/docs/oreilly-book/index.html, but actually only the french version is printed, i guess)
<ikaros> yea i think so too. i downloaded the english version
<two-face> it is a bit outdated though
<ikaros> i just need something to have a start. i can lookup all those libs in the official doc later ;)
<two-face> but it is good
<two-face> i have it in my bookcase
<ikaros> yea i like it so far
chessguy has joined #ocaml
Kzzch has joined #ocaml
Kzzch has left #ocaml []
malapropism has joined #ocaml
love-pingoo has quit ["Leaving"]
<ikaros> could anyone have a look at this ? http://rafb.net/paste/results/EAVBGd38.html and explain me why i "akku" is an unbound value in line 5
<ikaros> i guess im doing something totally wrong.. but i dont get it
<two-face> you need to create akku
<ikaros> this function should generate a list of numbers from 0 to 8 randomly but every number appearing only once
<ikaros> hm
<two-face> where do you create it?
<flux__> ikaros, 'akku' is only valid inside 'roll'
<ikaros> yea ok
<flux__> ikaros, you need to check for the list length inside the recursive loop
<ikaros> ok. i guess i didnt understand that "in" keyword right so far..
<two-face> oh, yeah
<two-face> i misread it
<ikaros> k i will have another try
<two-face> i thought it was parameter passing
<two-face> not function declaration
<ikaros> hm yea.
<ikaros> another question
<ikaros> do i need this whole "in" thing here? i guess i dont
<flux__> you need
<flux__> I've seen it suggested that reading it out loud helps: "let symbol be of value IN the following expression"
<flux__> I don't know if it does ;)
<ikaros> hehe thanks i will try
redacted has quit [Read error: 113 (No route to host)]
<ikaros> i feel that im getting something totally wrong here..
<ikaros> trying this http://rafb.net/paste/results/SmK8Nh19.html , i get a stack overflow.. guess it calls roll with [] all the time?
<flux__> you have a precedency problem
<flux__> in the else-statement
<flux__> it is parsed as (roll (Random.int 9) akku) @ [num]
<flux__> so you need to add parenthesis
<ikaros> ohhh
<ikaros> lol that was it
<ikaros> .. thank you! ;)
<flux__> glad to help
<ikaros> btw is this a good method to create a list like that?
<flux__> no ;)
<ikaros> i thought so ;)
<ikaros> so better create it with cons? ::
<flux__> yes
<ikaros> thing is i need to check whats in list yet
<ikaros> yet->already
<flux__> you can change your approach
<ikaros> ..
<flux__> to something much more efficient
<flux__> start with a list of desired numbers and then shuffle that
<flux__> this way you don't need to check for duplicates
<ikaros> yea good idea
<flux__> and there's a way to do the shuffling efficiently too ;)
<ikaros> =)
<ikaros> guess i read what you mean
<ikaros> but i dont remember exactly.. they swapped a tuple
<flux__> ((too much of a) hint: List.sort)
<ikaros> was something like (x,y) -> y,x
<ikaros> ok
<ikaros> =)
bebui has joined #ocaml
bebui has quit [Client Quit]
bebui has joined #ocaml
velco has quit ["Ex-Chat"]
chessguy has quit [" HydraIRC -> http://www.hydrairc.com <-"]
descender has quit [Read error: 54 (Connection reset by peer)]
Wild_Cat has joined #ocaml
two-face has left #ocaml []
Smerdyakov has joined #ocaml
redacted has joined #ocaml
Payo543 has quit [Remote closed the connection]
postalchris has joined #ocaml
<ikaros> flux__, could you tell me why this: http://rafb.net/paste/results/ADxtWU68.html always returns the same results?
smimou has joined #ocaml
<Smerdyakov> Same as the problem with "randomenss" stuff in most language's standard libraries: you aren't seeding the generator.
<Smerdyakov> By the way, using List.sort is a rather inefficient way to permute a list randomly. :)
<ikaros> lol
<ikaros> =)
<flux__> smerdyakov, hmm.. what is more efficient? except using array.
<Smerdyakov> It's also true that your comparison function doesn't meet the conditions given in the manual for arguments to List.sort.
<ikaros> so what would be a better way?.. not that it would be that important in the program but i need to learn ;)
<flux__> (I'd imagine atleast)
<Smerdyakov> It probably works anyway, but it's rather iffy.
<ikaros> hm but it returns ints
<ikaros> positive and negative
<Smerdyakov> But it isn't a mathematical function; it will have different behavior for the same inputs over time.
<ikaros> yea but that wouldnt be bad for my purpose.. in fact i dont care for x y..
<ikaros> i only need to shuffle..
<ikaros> the less i know of x y the better.. ;)
<Smerdyakov> flux__, I don't know. It just seems awry, and I don't have a precise statement of the trouble.
malapropism has quit [Read error: 113 (No route to host)]
<flux__> smerdyakov, I'm thinking that it's O(n log n) to randomly shuffle an array with.. if there's a O(n) way, then obviously it is slow ;)
duncanm has joined #ocaml
<flux__> I mean a list, not an array
<Smerdyakov> flux__, I vaguely recall something from Knuth.
<flux__> I suppose randomly swapping each element with some other one would be O(n), but doesn't work with lists
<Smerdyakov> flux__, but it's fair game to convert to an array and then back. :)
<flux__> smerdyakov, I suppose it is, as it's O(n) ;)
<ikaros> i dont care that much for the time or complexity.. id rather love a "good" randomness
<flux__> I wonder which is faster.. constructing a list with a random number pair and sort by that random number, or that list->array->shuffle->list
<Smerdyakov> I also wonder how the results of this use of List.sort of distributed.
<Smerdyakov> It would be surprising (to me) if it achieved a uniform distribution.
<flux__> oh right, that use isn't what I had in mind
Wild_Cat has quit [" HydraIRC -> http://www.hydrairc.com <- Try something fresh"]
<ikaros> well.. it isnt a bad thing to have a faster function ;) if it still does what it should
<ikaros> in this case i dont really understand why its the same result every! time..
<Smerdyakov> ikaros, there is no such thing as a random number generator.
<ikaros> yea i know
<Smerdyakov> ikaros, most every language's standard library implementation starts from a seed and modifies it in a predictable way on every call asking for a new number.
<Smerdyakov> ikaros, the seed often starts with the same default on every program run.
<ikaros> i know.. but i can run this function multiple times.. and its always the same
<Smerdyakov> ikaros, it's your responsibility to set it to something different if you want different behavior.
<Smerdyakov> Another thing is that you probably get no guarantee that result isn't always even....
<Smerdyakov> But you're sure you're calling it multiple times in the same session?
<ikaros> did it for test yes
<ikaros> and it returned the same list every time..
datrus has joined #ocaml
<Smerdyakov> Perhaps Random always returns the same number if you don't seed it.
_JusSx_ has joined #ocaml
<ikaros> it didnt when i tried it manually with Random.int(2) in the interpreter
duncanm_ has quit [Read error: 110 (Connection timed out)]
<_JusSx_> ocaml or SML?
<ikaros> ocaml
<Smerdyakov> SML
<datrus> can anybody help me out? when I do 'Set.Make Int;;' in the ocaml interactive prompt I get: 'Unbound constructor Set.Make'. I thought the Set module was linked by default??
<flux__> ikaros, it maybe just that the function is really bad ;)
<_JusSx_> ikaros: do you know SML?
<Smerdyakov> datrus, OCaml modules are not first class.
<Smerdyakov> datrus, you can't "run" a functor call anonymously.
<ikaros> _JusSx_, i thought that was a reply on my problem ;)
<ikaros> flux__, well yea it maybe.. but what is it exactly thats so bad about it?
<flux__> I can't work out what it would do, really
<flux__> sorting on random condition..
<flux__> I'm not certain it produces anything useful
<ikaros> i tried the shuffle part manually to now.. it returns "random" results..
love-pingoo has joined #ocaml
<flux__> this is what I had in mind and it works: let magic9 = let shuffle l = List.map snd (List.sort compare (List.map (fun a -> Random.float 100000.0, a) l)) in shuffle [0; 1; 2; 3; 4; 5; 6; 7; 8; 9];;
<flux__> I suppose it has a really small bias of keeping the elements sorted
<flux__> actuall 1.0 should do just as well as 100000.0
<flux__> (I played with Random.int first)
<flux__> smerdyakov, isn't that ever-so-much more elegant than list->array->list ;)
<ikaros> hmm so that works for you?
<ikaros> i guess something is broken here..
<flux__> how are you testing that?
<flux__> note that magic9 isn't a function
<flux__> it's a value
<ikaros> hmm
<flux__> if you want it to be a function, write it like let magic9 () = .. and evaluate it with magic9 ();;
<ikaros> doh..
<ikaros> hehe thanks.. now it works like expected...
Oatmeat|umn has joined #ocaml
Payo543 has joined #ocaml
pango has joined #ocaml
<pango> ikaros: another "standard" implementation: http://nopaste.tshw.de/11605889285428c/
<ikaros> thx ;) my implementation works now as a function ..
<ikaros> ah with array to list .. i changed the whole stuff to work with array directly
<pango> drop the Array.to_list then ;)
<pango> it's not part of the algorithm
<ikaros> ye well i guess i can use my version.. it works flawlessly since it became a function lol
<ikaros> still no math function but well..
<pango> well, not mentionned unefficiencies, I doubt such shuffle will be randomly uniform
<ikaros> because there is no seed init?
<pango> it will be difficult to prove anything about your function
<pango> as Smerdyakov said, not using a comparison function breaks Array.sort contract, so the result depends on the implementation of Array.sort
<ikaros> well i read the doc and there was said that it uses the int values it gets from the compare function
<ikaros> so its kinda black box for sort isnt it
<pango> second, your shuffle x y function returns 0 1/9th of the time, positive 4/9th of the time and negative 4/9th of the time... the exact values do not matter for a comparison function...
ziggurat has quit ["Leaving"]
<pango> ikaros: the contract says it must be a function, your shuffle isn't a function, in the mathematical sense
<bluestorm> hum
<ikaros> well ..
<bluestorm> (if Random.bool() then 1 else (-1)) would be simpler
<ikaros> yea
<ikaros> had that first
<ikaros> =)
<ikaros> i could switch back to it yes
<pango> there's no guarantee that compare a a = 0, that compare a b < 0 <=> compare b a > 0, or even that computing compare a b twice will give the same result...
<pango> (I forgot compare a b > 0 && compare b c > 0 => compare a c > 0)
<pango> you're just abusing Array.sort, so the result is undetermined
<ikaros> well the only guarantee i need is that it sorts with random values
<ikaros> and that should be given
<ikaros> yea im kinda abusing it thats right
<pango> the distribution is most probably not uniform
<bluestorm> hum
Leonidas has quit ["An ideal world is left as an exercise to the reader"]
<pango> for example, it seems that half of the time the last element will be 0
love-pingoo has quit ["Connection reset by pear"]
_fab has quit [Read error: 110 (Connection timed out)]
<Payo543> is there any small web servers written in Ocaml ?
_fab has joined #ocaml
<ayrnieu> ask the hump. If there aren't, there should be.
<ikaros> pango, nice statistics thanks ;)
<Payo543> pango, A web server able to execute caml applets to generate dynamic pages.
<Payo543> what exactly is caml applets ?
shawn has quit ["This computer has gone to sleep"]
malapropism has joined #ocaml
chessguy has joined #ocaml
shawn has joined #ocaml
shawn has quit [Read error: 145 (Connection timed out)]
redacted has quit [Read error: 113 (No route to host)]
shawn has joined #ocaml
Godeke has quit [Read error: 110 (Connection timed out)]
pango has quit [Remote closed the connection]
pango has joined #ocaml
Snark has quit ["Leaving"]
<Payo543> does ocaml have any fast cgi kinda things ?
shawn has quit [Read error: 110 (Connection timed out)]
Skal has quit [Connection reset by peer]
<bluestorm> Payo543: just look at the hump
<Payo543> hmmmmmmm
<Payo543> i am wondering if i should write my whole web app in ocaml or lua
bluestorm has quit ["Konversation terminated!"]
kmacy_ has quit ["Leaving"]
malapropism has quit [Read error: 113 (No route to host)]
rillig has joined #ocaml
shawn has joined #ocaml
<abez> Payo543: I've seen fastcgi libs for ocaml
<abez> That's a bad example
<abez> there are others
_JusSx_ has quit ["leaving"]
KirinDave has joined #ocaml
_fab has quit [Remote closed the connection]
<Payo543> has anyone here ever embedded lua in ocaml ?
<Payo543> also what is a good way to make graphs in ocaml and display them on screen
<Payo543> web page
<datrus> is there a builtin function that generates lists from 0..n ?
<datrus> a la python's range
<pango> datrus: no
<datrus> ok i will build my own iota then
postalchris has quit ["Leaving."]
<ayrnieu> use streams.
<abez> datrus: I always end up making stuff like that
malc_ has joined #ocaml
<Payo543> hmmmm
<Payo543> i guess i should use the GD bidning and make my own graph
smimou has quit ["bli"]
danly has quit ["Leaving"]
Mr_Awesome has joined #ocaml