mbishop changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | Grab Ocaml 3.10.0 from http://caml.inria.fr/ocaml/release.html (featuring new camlp4 and more!)
screwt8 has quit [Remote closed the connection]
rumpl has joined #ocaml
screwt8 has joined #ocaml
<rumpl> Hi, I'm reading this tutorial: http://www.ocaml-tutorial.org/the_structure_of_ocaml_programs, and I can't compile the example with Graphics, I do this: ocamlc graphics.cma -o test ex.mli, and it says "Syntax error" for open_graph, but when I execute the script with ocaml graphics.cma ex.mli, it works. What am I doing wrong?
<Smerdyakov> Probably a semicolon problem.
<rumpl> http://rafb.net/p/JP0CJP60.html As I said, it works fine with ocaml, but it wont compile
<Smerdyakov> A useful fact: you never need any double-semicolons in files that you process in batch mode, such as by compiling them with 'ocamlc'.
<Smerdyakov> Or, rather, almost never... certainly not for this example.
<Smerdyakov> I imagine it would compile if you ate all the semicolons and prefaced each top-level expression with 'let _ = '.
<rumpl> Yes, well this is a copy/paste, and event without the ";;" it won't compile.
<Smerdyakov> I know. I didn't say that simply erasing them yields a valid program.
<rumpl> OK. Sorry
<Smerdyakov> Anyway, the file you pasted compiles for me.
<rumpl> Oh.
<Smerdyakov> You might have a bizarre version of OCaml.
<rumpl> I have 3.09.2 I'm on Debian
* Smerdyakov feels nauseous after seeing that ocaml-tutorial mentions 'for' loops in so short an introduction.
<rumpl> Both of these examples make use of some features we haven't talked about yet: imperative-style for-loops, if-then-else and recursion. We'll talk about those later. << This is what it says later.
<rumpl> This is just for the open thing
<rumpl> So, any idea why it wont compile? I have the graphics.* in /usr/lib/ocam/<version>
<Smerdyakov> Do you mean /usr/lib/ocaml/<version>?
<rumpl> Yes.
pango has quit [Remote closed the connection]
<Smerdyakov> Sorry, I don't know what could cause this.
<rumpl> If I comment the open_graph line, the compiler complains about the "for" ... It complains about everything after open Graphics;; acctually.
<rumpl> Well, thanks for trying, will search the web.
pango has joined #ocaml
<Smerdyakov> Now hoooold on.
<rumpl> Yes?
<Smerdyakov> What's this about "ex.mli"?
<rumpl> That's the name of my file.
<Smerdyakov> The file clearly says to name it "grtest1.ml"./
<Smerdyakov> The name doesn't matter, but the extension sure does.
<rumpl> Does the name has something to do with it?
<rumpl> Oh.
<rumpl> Works now. Ok, so to compile it has to ba a .ml file.
<rumpl> Good to know,
<rumpl> Thanks.
<Smerdyakov> No, that's not true.
<Smerdyakov> Different file extensions denote different kinds of source code.
<Smerdyakov> You wrote the wrong kind of source code for the extension you were using.
<Smerdyakov> But the same compiler handles .ml and .mli files.
<rumpl> And what it a mli file?
<Smerdyakov> BTW, either you're not reading the tutorial carefully or it has a bug in suggesting to use .mli.
<Smerdyakov> If the latter, you should report this to the authors.
<rumpl> I acctually don't know why I chose the mli extension.
<Smerdyakov> OK. Don't do random things when learning a programming language.
<rumpl> Nah, in the tutorial the first line is this: (* To compile this example: ocamlc graphics.cma grtest1.ml -o grtest1 *), the file has .ml extension.
<rumpl> So what is an mli file? What is the difference between ml and mli files?
<Smerdyakov> You are making a serious meta-mistake: not using the reading material available to you. If it doesn't answer that question, then there is probably a good reason not to present that material yet.
<rumpl> Ok.
<rumpl> Thank you anyway.
authentic has joined #ocaml
<authentic> omg so many people here
<authentic> didn't know ocaml was that huge :)
krumms has joined #ocaml
<bluestorm_> hm
<krumms> parsing an inbound HTTP request with a functional flavour: any suggestions?
<bluestorm_> i remember a web server is one of the things i tried when learning ocaml ^^
<krumms> bluestorm_: I was actually kinda surprised at how easy it was. Granted, it's very simple. But all the same ... gave me a little bit of insight as to how powerful Ocaml can be
<bluestorm_> :p
<bluestorm_> hm
<bluestorm_> let len = (String.length s) in
<bluestorm_> ( ) are unnecessary
<krumms> okay, thanks
<krumms> sorry about the file name by the way ... Wordpress seems to have munged it. :(
<bluestorm_> hm
<bluestorm_> Str may not be thread-safe
xavierbot has quit [Read error: 110 (Connection timed out)]
<bluestorm_> i think establish_server use fork() anyway
<krumms> bluestorm_: yeah it creates a new process
<krumms> I was concerned about that too
<krumms> :)
<bluestorm_> hm
<bluestorm_> (List.fold_left (fun acc (header, value) ->
<bluestorm_> (header ^ ": " ^ value) :: acc) [] headers)
<bluestorm_> is that not a List.map ?
<bluestorm_> (hm, plus reverse ?)
<bluestorm_> (does the order really matters here ?)
<krumms> I don't know if header order is ever important in the HTTP spec ... in most cases I'd assume not, but I'd have to check
<bluestorm_> your fold_left looks like a List.map
<krumms> yeah you're right :)
<bluestorm_> hm
<bluestorm_> trim and ltrim are strange
<krumms> I know. Writing them was awkward
<bluestorm_> i'm not sure doing a String.sub at each space removing is the best way to do
<bluestorm_> hm
<krumms> Is there a better way to do it?
<bluestorm_> i'd use a auxiliary recursive function to keep the index until the end
<bluestorm_> and sub then
<krumms> sure
<bluestorm_> i think this way you could even merge them
<bluestorm_> (that's all about the index incrementation after all)
<bluestorm_> hm
<bluestorm_> aren't you only used trim anyway ?
<bluestorm_> (if it is the case you may make it explicit by definind ltrim and rtrim inside trim)
<bluestorm_> hm
<krumms> yup, only using trim directly
<krumms> ltrim & rtrim came about as a result of that horrid implementation :)
<bluestorm_> i think you should avoid using ^ when possible
<bluestorm_> it as the same flaws as @ concerning complexity
<bluestorm_> your status_line for example could use String.concat " " [...;...;...]
<bluestorm_> (and the output String.concat "\r\n" [..; ..; ""; ...] )
<bluestorm_> hm
<bluestorm_> you can use fst as a convenience function for let left, _ = cpl in left
<bluestorm_> (snd is the other one)
<bluestorm_> hm
<bluestorm_> | _ -> internal_server_error ()
<bluestorm_> you may be intersted in better error reporting
<bluestorm_> the Printexc module ( http://caml.inria.fr/pub/docs/manual-ocaml/libref/Printexc.html ) can do that
<krumms> brilliant, thank you
<krumms> this is all very helpful
david_koontz has quit ["Leaving"]
bluestorm_ has quit ["Konversation terminated!"]
seafoodX has joined #ocaml
seafoodX has quit []
slipstream-- has quit [Read error: 110 (Connection timed out)]
jlouis_ has joined #ocaml
jlouis has quit [Read error: 110 (Connection timed out)]
buluca has quit [Read error: 113 (No route to host)]
rumpl has quit ["Ex-Chat"]
_blackdog has quit [Remote closed the connection]
robyonrails has quit [Connection timed out]
netx has joined #ocaml
netx has quit ["Leaving"]
paf has quit ["Leaving"]
zarvok has quit ["BitchX-1.1-final -- just do it."]
slipstream has joined #ocaml
piggybox__ has joined #ocaml
jeremiah has joined #ocaml
jeremiah has left #ocaml []
masteraka has left #ocaml []
Mr_Awesome has quit ["time to impregnate a moth"]
piggybox has quit [Connection timed out]
<krumms> let foo = ["There are"; string_of_int 5; "cheeky little monkeys hiding in the tree"] in String.concat " " foo ;;
shawn has quit [Read error: 113 (No route to host)]
robyonrails has joined #ocaml
piggybox has joined #ocaml
piggybox_ has joined #ocaml
piggybox__ has quit [Read error: 110 (Connection timed out)]
piggybox has quit [Connection timed out]
ygrek has joined #ocaml
krumms has quit ["Leaving"]
shawn has joined #ocaml
smimou has joined #ocaml
shawn has quit ["This computer has gone to sleep"]
seafoodX has joined #ocaml
robyonrails has quit ["me ne vo'"]
robyonrails has joined #ocaml
eroyf has quit [Connection timed out]
eroyf has joined #ocaml
eroyf has quit [Client Quit]
bluestorm_ has joined #ocaml
xavierbot has joined #ocaml
seafoodX has quit []
buluca has joined #ocaml
smimram has joined #ocaml
<flux> foo;;
<xavierbot> Characters 0-3:
<xavierbot> foo;;
<xavierbot> ^^^
<xavierbot> Unbound value foo
<flux> find;;
<xavierbot> Characters 1-5:
<xavierbot> find;;
<xavierbot> ^^^^
<xavierbot> Unbound value find
<flux> good morning
<flux> Thread.create;;
<xavierbot> Characters 1-14:
<xavierbot> Thread.create;;
<xavierbot> ^^^^^^^^^^^^^
<xavierbot> Unbound value Thread.create
shawn has joined #ocaml
buluca has quit [Read error: 113 (No route to host)]
smimou has quit [Read error: 110 (Connection timed out)]
buluca has joined #ocaml
seafoodX has joined #ocaml
joshcryer has quit [Read error: 104 (Connection reset by peer)]
joshcryer has joined #ocaml
rwmjones_ has left #ocaml []
minciue has joined #ocaml
minciue has left #ocaml []
ygrek has quit [Remote closed the connection]
tsuyoshi has joined #ocaml
<tsuyoshi> hi
DirkT has joined #ocaml
robyonrails has quit ["me ne vo'"]
ygrek has joined #ocaml
noteventime has joined #ocaml
_blackdog has joined #ocaml
_blackdog has left #ocaml []
ygrek has quit [Remote closed the connection]
joshcryer has quit [Nick collision from services.]
joshcryer has joined #ocaml
screwt8 has quit [Remote closed the connection]
piggybox_ has quit [Read error: 110 (Connection timed out)]
screwt8 has joined #ocaml
<Ober> let rec loop () = loop () ;; loop () ;;
<xavierbot> val loop : unit -> 'a = <fun>
kelaouchi has quit [Client Quit]
kelaouchi has joined #ocaml
kelaouchi has quit [Client Quit]
kelaouchi has joined #ocaml
piggybox has joined #ocaml
buluca has quit [Connection timed out]
robyonrails has joined #ocaml
ygrek has joined #ocaml
seafoodX has quit []
pango has quit [Remote closed the connection]
pango has joined #ocaml
noteventime has quit [Remote closed the connection]
piggybox has quit [Read error: 110 (Connection timed out)]
piggybox has joined #ocaml
seafoodX has joined #ocaml
piggybox_ has joined #ocaml
noteventime has joined #ocaml
mphill22 has joined #ocaml
DirkT has left #ocaml []
piggybox__ has joined #ocaml
piggybox has quit [Read error: 110 (Connection timed out)]
buluca has joined #ocaml
buluca has quit [Client Quit]
piggybox has joined #ocaml
seafoodX has quit []
piggybox_ has quit [Success]
piggybox__ has quit [Read error: 110 (Connection timed out)]
slipstream-- has joined #ocaml
slipstream has quit [Read error: 113 (No route to host)]
db4n has joined #ocaml
<db4n> Hello, is anyone here?
kig has joined #ocaml
<Ober> db4n: no
piggybox_ has joined #ocaml
<db4n> Ober: Darn. I need help loading .cmo files into the toplevel.
<db4n> It says all the values in my file are Unbound.
<Smerdyakov> Did you read the manual page for 'ocaml'?
smimram has quit ["bli"]
<db4n> Smerdyakov: Yes, it says you can either list .cmo files as args to ocaml
<db4n> or #load them once you're in.
<Smerdyakov> If you want help, you should give a concrete example, say what you expected to happen, and say what really happens.
piggybox__ has joined #ocaml
piggybox has quit [Read error: 110 (Connection timed out)]
piggybox__ is now known as piggybox
<flux> db4n, I'm thinking you don't take into account that the loaded files are in their own modules: foo.cmo's objects need to be referred by Foo.xxx, unless you explicitly bring them to your current name space with open
piggybox_ has quit [Read error: 110 (Connection timed out)]
shawn has quit ["This computer has gone to sleep"]
<db4n> flux: That's it, thanx. I forgot OCaml does that automatically.
<db4n> Wow, bytecode running on externally defined data is 14 times slower than camlopt'd code
<db4n> operating on hard-coded data.
qwwqe has joined #ocaml
smimou has joined #ocaml
noteventime has quit [Remote closed the connection]
masteraka has joined #ocaml
<jlouis_> db4n: that shouldn't be a surprise ;)
<flux> instead of concentrating on how slow the interpreted byte-code is, you should concentrate on how fast the optimized version is ;)
Submarine has joined #ocaml
shawn has joined #ocaml
<db4n> jlouis, flux: :) The interesting question is what makes the most difference.
<db4n> bytecode vs. native
<db4n> or external data vs. internal (code can be optimized).
pango- has joined #ocaml
david_koontz has joined #ocaml
shawn has quit [Connection timed out]
ygrek has quit ["Leaving"]
pango has quit [Nick collision from services.]
pango- is now known as pango
shawn has joined #ocaml
<pango> db4n: relative speed depends on the kind of code, and 14 times look close to the upper bound of bytecode slowdown (I've seen x2~x15 range mentionned)
rumpl has joined #ocaml
<rumpl> http://rafb.net/p/V8wsxL30.html << Line 12, why can't I create an (Int -4) and I can create (Int m) with m = -4? How can I create directly a negative Int?
_blackdog has joined #ocaml
_blackdog has quit [Remote closed the connection]
<pango> - is interpreted as infix operator, try Int ~-4 or Int (-4)
<rumpl> Yes, ~-4 works fine thank you. May i ask what is the meaning of '~'? Surely I will see it later on the doc, but I'm curious :)
<pango> ~- is the unary operator
<pango> for negation
<rumpl> Ok.
<pango> there's also ~-. for floats. For some reason they're not often used ;)
<rumpl> And why does Int (-4) work too?
<rumpl> :)
<rwmjones> isn't it
<rwmjones> ~1;;
<xavierbot> - : int = 1
<rwmjones> strange ...
<rwmjones> -1;;
<xavierbot> - : int = -1
<rwmjones> ~-1;;
<xavierbot> - : int = -1
<rwmjones> ~foo;;
<rwmjones> "foo";;
<xavierbot> Characters 1-5:
<xavierbot> Failure: "labeled expression not allowed here"
<xavierbot> ~foo;;
<xavierbot> ^^^^
<pango> # ~1
<pango> Syntax error
<rwmjones> yeah, I was misremembering. In real code I always just bracket it ... (-1) ...
<rumpl> I see you have a bot. Nice.
<rwmjones> rumpl, even better, it's written in perl :-)
<pango> those operators are not very sexy
<rumpl> Blasphemy! Why in perl? Why not in ocaml?
<rwmjones> well, it was the easiest way to get something to talk to IRC, given the existing libraries for this in perl are very rich
<rwmjones> obviously the toplevel itself is the ocaml toplevel ...
<rumpl> Ok ;)
<rwmjones> I didn't reimplement ocaml in perl
<rwmjones> that would be
<rwmjones> ambitious
<rumpl> Yes.
<rumpl> What is the version on ocaml running with this bot?
<rwmjones> 3.10.0
<rwmjones> xavierbot, restart yourself
<xavierbot> Objective Caml version 3.10.0
<xavierbot> Camlp4 Parsing version 3.10.0
<pango> Sys.ocaml_version (* probably won't work ? *) ;;
<xavierbot> Characters 0-17:
<xavierbot> Sys.ocaml_version (* probably won't work ? *) ;;
<xavierbot> ^^^^^^^^^^^^^^^^^
<xavierbot> Unbound value Sys.ocaml_version
<pango> right
<rwmjones> I've just spent the day debugging manual memory allocation problems in a C program ... makes you appreciate the finer things in life
<rwmjones> no, lots of modules such as Sys are not available
<rwmjones> intentionally :-)
<rumpl> Well thanks for your help.
<rumpl> rwmjones, do you use valgrind?
<rwmjones> yes we do
<pango> rwmjones: lack of most libraries makes xavierbot less useful, however
<rwmjones> pango, if you want to suggest a library or function then let me know and I'll add it (if safe)
<rumpl> Sometimes a grep malloc <file>| wc -l and grep free <file> | wc -l does the thing
<rumpl> For little projects.
<rwmjones> pango, I've steered clear from adding large C-based external libs such as Pcre however because they are so hard to audit
<rwmjones> rumpl, this is a huge C program, and the bug was in code which was doing manual memory stuff with XDR (the data representation layer for SunRPC)
<rwmjones> rumpl, not that easy to debug - I was just using gdb in the end, but found it
<rumpl> Ok, so grep won't work :)
<rumpl> Is the bot chrooted? What happens when somebody tries to do some file handling with the bot?
<rwmjones> rumpl, actually my description wasn't so good. It wasn't a memory leak or anything like that, but the nasty pointer arithmetic that XDR makes you go through
<rwmjones> rumpl, yes, chrooted & running as nobody & with very low rlimits
<rwmjones> let rec loop () = loop () ;;
<xavierbot> val loop : unit -> 'a = <fun>
<rumpl> :)
<rwmjones> loop () ;;
<pango> rwmjones: well, what's potentially harmful in Sys? Make xavierbot ignore some signals from its wrapper maybe?
<xavierbot> Objective Caml version 3.10.0
<xavierbot> Camlp4 Parsing version 3.10.0
<rwmjones> pango, there's a lot of unsafe stuff in Sys, eg. all the stuff for reading the local filesystem
<pango> rwmjones: but isn't the bot chrooted already?
<rumpl> Well sometimes chroot isn't good enough.
<pango> rumpl: which means something it is
<pango> s/something/sometimes/
<rumpl> True.
<rwmjones> multiple layers of defence
<rwmjones> sorry, sb just came to the door
<rwmjones> yes anyway I'm sure that parts of Sys are safe
<rwmjones> I'm wary of large external libs though
<pango> module H = Hashtbl ;;
<xavierbot> module H :
<xavierbot> sig
<xavierbot> type ('a, 'b) t = ('a, 'b) Hashtbl.t
<xavierbot> val create : int -> ('a, 'b) t
<xavierbot> val clear : ('a, 'b) t -> unit
<xavierbot> val add : ('a, 'b) t -> 'a -> 'b -> unit
<xavierbot> val copy : ('a, 'b) t -> ('a, 'b) t
<xavierbot> val find : ('a, 'b) t -> 'a -> 'b
<xavierbot> val find_all : ('a, 'b) t -> 'a -> 'b list
<xavierbot> val mem : ('a, 'b) t -> 'a -> bool
<rwmjones> it'll only print the first 10 lines or so to prevent flooding
<rumpl> And in pv?
<pango> Good, so you added abstract datastructure modules?
<rwmjones> rumpl, pv?
<pango> that look safe and more interesting than Sys
<rwmjones> pango, there are lots of modules in there - I urge you to download the source and look at the file "init.in" to see ...
<rumpl> Sorry, private messages.
<rwmjones> no, /msg is not yet implemented ... waiting for someone to send me a patch :-)
<rwmjones> actually there are tricky issues with private messages
<rumpl> ;) ok.
<rwmjones> for instance
<rwmjones> everyone shares the same toplevel instance
<rwmjones> but should someone be allowed to change the state of the toplevel "in secret" (so to speak)?
<rwmjones> for instance by redefining some function
<rwmjones> or should private messages start their own toplevel for each sender? (tricky to implement that)
<rumpl> I see.
db4n has left #ocaml []
love-pingoo has joined #ocaml
rwmjones has quit ["Closed connection"]
xavierbot has quit [Remote closed the connection]
shawn has quit [Connection timed out]
shawn has joined #ocaml
piggybox has quit [Read error: 104 (Connection reset by peer)]
pango_ has joined #ocaml
pango has quit [Nick collision from services.]
pango_ is now known as pango
shawn has quit [Read error: 110 (Connection timed out)]
masteraka has left #ocaml []
noteventime has joined #ocaml
love-pingoo has quit ["Connection reset by pear"]
piggybox has joined #ocaml
deatheye has joined #ocaml
Submarine has quit [Remote closed the connection]
pango has quit [Remote closed the connection]
<noteventime> Has anyone heard of Qt or KDE bindings for OCaml?
pango has joined #ocaml
robyonrails has quit [Read error: 110 (Connection timed out)]
mphill22 has left #ocaml []
Submarine has joined #ocaml
<bluestorm_> noteventime: there are not yet
<bluestorm_> (hm, please excuse my awful english : there isn't any binding yet)
asmanur has joined #ocaml
<noteventime> bluestorm_: Too bad :-/
<bluestorm_> hm
<bluestorm_> actually
<noteventime> Maybe I'll have a try at generating some
<bluestorm_> you could use pycaml + pyqt for example
<bluestorm_> hm
<noteventime> Doesn't seem like a very good way of doing it :-P
<bluestorm_> noteventime: more generally, you could interact with a scripting langage that would care about the UI
<bluestorm_> hm
<noteventime> Maybe there are some SWiG files available
<bluestorm_> kalyptus does has a SWIG awful
<noteventime> Seems like over complex for small applications
<bluestorm_> but... it's really awful
<bluestorm_> hm
hsuh has joined #ocaml
<bluestorm_> noteventime: you could go for LablGTK
<noteventime> I don't like GTK
<bluestorm_> GTK is rather nice once you don't code in C anymore
<noteventime> LablGTK is slightly better, yes
<noteventime> But I still don't like the API
<noteventime> So I'd rather avoid it
<noteventime> If possible
<asmanur> noteventime: use graphics ? :-°
qwwqe has quit ["Leaving"]
<noteventime> Manually write a GUI toolkit? :-P
<asmanur> why not ? :D
<hsuh> after checking out thumper web server, i ask you: is it difficult to implement a simple irc server?
<Smerdyakov> hsuh, implementing an IRC server that provides its own one-node network is easy.
piggybox has quit ["Leaving"]
<noteventime> asmanur: Becuase I have more interesting things to do? ;-)
<hsuh> Smerdyakov: yes, i was thinking in something totally non distributed... only for internal use at the company
<asmanur> noteventime: or wait for bluestorm to find a way to implement signals :-°
<noteventime> asmanur: Someones working at a signal system for OCaml?
<asmanur> No no ...
<noteventime> ok
<asmanur> i was joking (don't press the trigger bluestorm_)
descender has joined #ocaml
smimou has quit ["bli"]
Submarine has quit [Remote closed the connection]
Submarine has joined #ocaml
Submarine has quit [Remote closed the connection]