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!)
buluca is now known as excess_flood
excess_flood is now known as buluca
noteventime has quit ["Leaving"]
pango has quit [Remote closed the connection]
pango has joined #ocaml
bluestorm_ has quit ["Konversation terminated!"]
test1234 has quit [Read error: 110 (Connection timed out)]
Azure_Ag has joined #ocaml
<Azure_Ag> Good evening, gentle creatures.
<mbishop> I'm not sure how gentle Smerdyakov is
<Azure_Ag> Well, I just can't be helpd for the quality of his evening if he's not.
<Azure_Ag> Err, held.
<Azure_Ag> I'm wondering if someone could tell me what I'm doing wrong in OCaml. I'm running Debian (amd64, sid) and I've got the libvorbis-ocaml-dev package installed, but when I try to do a #load "vorbis/vorbis.cma";; It tells me it can't load the dllvorbis_stubs library and gives the reason /usr/lib/ocaml/3.09.2/stublibs/dllvorbis_stubs.so: undefined symbol: ov_clear.
<Azure_Ag> I tried recompiling it (the vorbis library) from source and it compiled cleanly, but I get the same error. I get the same one with libmad-ocaml-dev.
robyonrails has joined #ocaml
vorago has joined #ocaml
robyonrails has quit [Read error: 110 (Connection timed out)]
rhz has joined #ocaml
shawn has quit [Read error: 110 (Connection timed out)]
<rhz> Is there a similar construct in ocaml to @ used in pattern matching in Haskell (I think it is called an as-pattern)?
yminsky has joined #ocaml
yminsky has quit []
boto has quit [Remote closed the connection]
robyonrails has joined #ocaml
david_koontz has quit ["Leaving"]
screwt8 has quit [Remote closed the connection]
m3ga has joined #ocaml
piggybox has joined #ocaml
dark_light has quit [Remote closed the connection]
<rhz> How can I convert something of type unit list to just unit by sequencing everything together?
buluca has quit ["Leaving."]
screwt8 has joined #ocaml
rhz has quit ["This computer has gone to sleep"]
m3ga has quit [Read error: 104 (Connection reset by peer)]
robyonrails has quit [Connection timed out]
shawn has joined #ocaml
vorago has quit [Read error: 113 (No route to host)]
bluestorm_ has joined #ocaml
bluestorm_ has quit [Client Quit]
robyonrails has joined #ocaml
Azure_Ag has quit ["Zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz-POP!"]
SanityInAnarchy has joined #ocaml
<SanityInAnarchy> I've downloaded some ocaml source, and compiling dies on a line: "open Types;;"
<SanityInAnarchy> I am guessing this is some standard library I'm missing?
SanityInAnarchy has quit ["leaving"]
rhz_ has joined #ocaml
<pango> rhz_: (pattern as variable)
<pango> match [1;2;3] with ((h::q) as l) -> Printf.printf "%d %d %d" h (List.length q) (List.length l) | [] -> assert false ;;
<xavierbot> 1 2 3- : unit = ()
Submarine has quit [Remote closed the connection]
<pango> rhz_: I'm not sure I understand your second question... My guess is that you're misusing some iterators (List.map instead of List.iter, or something)... Who needs unit lists? ;)
b00t has joined #ocaml
bluestorm_ has joined #ocaml
robyonrails has quit ["me ne vo'"]
<rhz_> pango: yeah, my second question was pointless. never mind that one.
Nutssh has quit ["Client exiting"]
rhz_ has quit ["This computer has gone to sleep"]
minciue has joined #ocaml
love-pingoo has joined #ocaml
test1234 has joined #ocaml
seafoodX has joined #ocaml
ygrek has joined #ocaml
shawn has quit [Connection timed out]
Amorphous has quit [Read error: 110 (Connection timed out)]
Amorphous has joined #ocaml
rhz has joined #ocaml
yminsky has joined #ocaml
Smerdyakov has quit ["Leaving"]
yminsky has quit []
m3ga has joined #ocaml
m3ga has quit [Client Quit]
Nutssh has joined #ocaml
rhz has quit [Read error: 110 (Connection timed out)]
test1234 has quit [Read error: 104 (Connection reset by peer)]
lde has quit [Connection timed out]
test1234 has joined #ocaml
splt has joined #ocaml
buluca has joined #ocaml
noteventime has joined #ocaml
seafoodX has quit []
love-pingoo has quit ["Connection reset by pear"]
ygrek has quit [Remote closed the connection]
ygrek has joined #ocaml
b00t has quit ["Leaving"]
buluca has quit [Read error: 113 (No route to host)]
test1234 has quit [Read error: 110 (Connection timed out)]
buluca has joined #ocaml
descender has quit ["Elegance has the disadvantage that hard work is needed to achieve it and a good education to appreciate it. - E. W. Dijkstra"]
hsuh has joined #ocaml
pango has quit [Remote closed the connection]
pango has joined #ocaml
hsuh has quit [Remote closed the connection]
hsuh has joined #ocaml
hsuh has left #ocaml []
zmdkrbou_ is now known as zmdkrbou
hsuh has joined #ocaml
splt has left #ocaml []
leo037 has joined #ocaml
hsuh has quit [Remote closed the connection]
hsuh has joined #ocaml
hsuh has left #ocaml []
hsuh has joined #ocaml
piggybox_ has joined #ocaml
yminsky has joined #ocaml
piggybox has quit [Read error: 110 (Connection timed out)]
piggybox_ is now known as piggybox
yminsky has quit []
<flux> ocamlidl seems nice. it was quite simple to wrap some of esound api with it.. there are still some non-trivial parts left, though (like converting a linked list from C to an ocaml list)
<flux> in case someone wants bindings sufficient for playing preloaded samples from esd, tested with a 10-line proggy, you can grab it here: http://www.modeemi.cs.tut.fi/~flux/software/ocamlesd/
<flux> help ();;
<xavierbot> Characters 1-5:
<xavierbot> help ();;
<xavierbot> ^^^^
<xavierbot> Unbound value help
<flux> let factoids = Hashtbl.create 100;;
<xavierbot> val factoids : ('_a, '_b) Hashtbl.t = <abstr>
<flux> let add key value = Hashtbl.replace factoids key value;;
<xavierbot> val add : '_a -> '_b -> unit = <fun>
<flux> let find key = Hashtbl.find factoids key;;
<xavierbot> val find : '_a -> '_b = <fun>
<xavierbot> - : unit = ()
<flux> find "ocamlesd";;
<flux> tada!
<flux> Str.quote;;
<xavierbot> - : string -> string = <fun>
<flux> let find x = try Hashtbl.find factoids x with Not_found -> let r = Str.regexp x in match Hashtbl.fold (fun key value v -> if Str.string_match r key 0 then (Some (key, value)) else v) factoids None with None -> Printf.printf "Not found" | Some (key, value) -> Printf.printf "%s = %s" key value;;
<xavierbot> Characters 84-293:
<xavierbot> let find x = try Hashtbl.find factoids x with Not_found -> let r = Str.regexp x in match Hashtbl.fold (fun key value v -> if Str.string_match r key 0 then (Some (key, value)) else v) factoids None with None -> Printf.printf "Not found" | Some (key, value) -> Printf.printf "%s = %s" key value;;
<xavierbot> ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
<xavierbot> This expression has type unit but is here used with type string
<flux> sigh..
<flux> ah
<flux> let find x = try Hashtbl.find factoids x with Not_found -> let r = Str.regexp x in match Hashtbl.fold (fun key value v -> if Str.string_match r key 0 then (Some (key, value)) else v) factoids None with None -> Printf.printf "Not found" | Some (key, value) -> Printf.sprintf "%s = %s" key value;;
<xavierbot> Characters 289-294:
<xavierbot> let find x = try Hashtbl.find factoids x with Not_found -> let r = Str.regexp x in match Hashtbl.fold (fun key value v -> if Str.string_match r key 0 then (Some (key, value)) else v) factoids None with None -> Printf.printf "Not found" | Some (key, value) -> Printf.sprintf "%s = %s" key value;;
<xavierbot> ^^^^^
<xavierbot> This expression has type string but is here used with type unit
<flux> let find x = try Hashtbl.find factoids x with Not_found -> let r = Str.regexp x in match Hashtbl.fold (fun key value v -> if Str.string_match r key 0 then (Some (key, value)) else v) factoids None with None -> "Not found" | Some (key, value) -> Printf.sprintf "%s = %s" key value;;
<xavierbot> val find : string -> string = <fun>
<flux> find "esd";;
<xavierbot> - : string = "Not found"
<flux> find "ocamlesd";;
<flux> how embarrassing..
<flux> dangers of coding on channel
<flux> find ".*";;
<xavierbot> - : string =
<flux> rwmjones, perhaps you could load a few nice libraries in.. like pcre.. if they are safe, and aren't already loaded ;)
Smerdyakov has joined #ocaml
<mbishop> find "dongs";;
<xavierbot> - : string = "Not found"
tochiro has joined #ocaml
<flux> actually, perhaps that's lame, it should always return string option..
<flux> or perhaps even (string * string) list option
<flux> hm, or just (string * string) list :)
rwmjones_ has joined #ocaml
<rwmjones_> flux, each library has to be checked in some detail to make sure it is safe
<Smerdyakov> What you really want is some kind of program analysis or proof-carrying code!
<rwmjones_> maybe I missed something, but what was wrong with letting it throw Not_found on a not found error?
<rwmjones_> yeah, I'd like to see that ...
<rwmjones_> anyone see my question:
<rwmjones_> & have any suggested further reading?
<Smerdyakov> Both of the challenge examples you ask for can be implemented easily doing things the old fashioned way, without those nasty polymorphic variants.
* Smerdyakov writes some code to demonstrate.
<rwmjones_> Smerdyakov, by "old fashioned way" what do you mean?
<Smerdyakov> You'll see. It's the only way we do it in SML.
<rwmjones_> ok :-)
* rwmjones_ did read the Paulson book on SML, but found it deadly dull (the book, not necessarily the language)
<Smerdyakov> OK, example one, disjunctions: http://www.schizomaniac.net/code/phantomOr.ml
<Smerdyakov> I just added two more bits, so reload if you already have it.
<Smerdyakov> And now constraints on numbers: http://www.schizomaniac.net/code/phantomNum.ml
hsuh has left #ocaml []
<Smerdyakov> I'm about to leave, so, if you want to ask any questions, now is a good time.
<rwmjones_> thanks, I was just playing with them in the toplevel
<rwmjones_> I'll catch you later no doubt :-)
tochiro has left #ocaml []
buluca is now known as bip_
bip_ is now known as buluca
<jlouis> Smerdyakov: nice trick.
<bluestorm_> hm
<bluestorm_> # type 'a a = {a : unit; b : 'a};;
<bluestorm_> type 'a a = { a : unit; b : 'a; }
<bluestorm_> # let rec test = function [] -> () | hd::tl -> hd.a; test tl;;
<bluestorm_> val test : 'a a list -> unit = <fun>
<bluestorm_> # test [{a = (); b = 1}; {a = (); b = 2.}];;
<bluestorm_> This expression has type float a but is here used with type int a
<bluestorm_> how can i resolve that ?
<jlouis> you have a list with a 'int a' and a 'float a' if I read that correctly
<bluestorm_> hm
<bluestorm_> i see
<bluestorm_> 'a a list
<jlouis> which is not allowed
<bluestorm_> does not mean elements type can be different
<bluestorm_> hmm
<jlouis> 'a a list needs to instantiate 'a before you can use it
<bluestorm_> something like second-order polymorphism would be needed here, wouldn't it ?
<bluestorm_> hm
<jlouis> yes. Higher ranked poly would do things
<bluestorm_> it's a shame :D
<jlouis> Depends a bit on what you want to do with code.
<bluestorm_> hm
<bluestorm_> i think i may be able to do that with OO's subtyping
<bluestorm_> but i don't really need that in my code anyway
<jlouis> you could do something like type foo = INT of int | FLOAT of float and then case on it if you really need a double representation
<jlouis> but those cases are going to drive you insane slowly
<bluestorm_> hm
<jlouis> I ponder what you need a non-uniform list for anyway
<bluestorm_> precisely
<bluestorm_> considered as a 'a a list
<bluestorm_> it's an uniform one
<bluestorm_> i mean
<bluestorm_> i could design polymorphic function that never access the b field
<bluestorm_> from their point of view, the list is uniform
<bluestorm_> my test function for example could handle [{a = (); b = 1}; {a = (); b = 2.}] without any typing problem
leo037 has quit ["Leaving"]
buluca has quit [Read error: 110 (Connection timed out)]
slipstream has joined #ocaml
buluca has joined #ocaml
ygrek has quit [Remote closed the connection]
Mr_Awesome has joined #ocaml
hsuh has joined #ocaml
slipstream-- has quit [Read error: 113 (No route to host)]
buluca has quit [Read error: 113 (No route to host)]
slipstream-- has joined #ocaml
hsuh has quit [Remote closed the connection]
slipstream has quit [Read error: 113 (No route to host)]
minciue has quit [Read error: 113 (No route to host)]
ramkrsna_ has joined #ocaml
EliasAmaral has joined #ocaml
Sparkles has joined #ocaml
shawn` has joined #ocaml
ramkrsna has quit [Read error: 113 (No route to host)]
Sparkles has quit []
hsuh has joined #ocaml
Cin has joined #ocaml
<rwmjones_> xavierbot, ping (help)
<xavierbot> hello rwmjones_, I am xavierbot 0.7, an OCaml toplevel
<xavierbot> expr ;; evaluate expr in toplevel and print result
<xavierbot> help help message
<xavierbot> restart restart the toplevel
<xavierbot> sleep go to sleep
<xavierbot> wake wake me up from sleep
EliasAmaral has quit [Remote closed the connection]
EliasAmaral has joined #ocaml
Sparkles has joined #ocaml
Sparkles has quit [Client Quit]
hsuh has quit ["rcirc on GNU Emacs 23.0.0.1"]
thorat has joined #ocaml
kig has joined #ocaml
buluca has joined #ocaml
pantsd has quit [Read error: 110 (Connection timed out)]
rwmjones_ has quit ["This computer has gone to sleep"]
pantsd has joined #ocaml
pantsd has quit [Remote closed the connection]
pantsd has joined #ocaml
EliasAmaral has quit [Remote closed the connection]
minciue has joined #ocaml