systems changed the topic of #ocaml to: http://icfpcontest.cse.ogi.edu/ -- OCaml wins | http://www.ocaml.org/ | http://caml.inria.fr/oreilly-book/ | http://icfp2002.cs.brown.edu/ | SWIG now supports OCaml| Early releases of OCamlBDB and OCamlGettext are available | Caml Weekly news http://pauillac.inria.fr/~aschmitt/cwn/
<stefp> Where I can learn the differences between ML, CAML and OCAML?
Vincenz has quit [Read error: 104 (Connection reset by peer)]
<taw> mmm
<taw> ml ?
<taw> there's no such thing ;)
<taw> if you want between sml and ocaml
<stefp> Standard ML?
<stefp> so that means there is a ML somewhere? :)
<taw> there was ml but some 20 years ago
<taw> you probably don't want it ;)
<stefp> I am a beginner in that class of language and I better understand things when motivated
<taw> well, sml doesn't have object system
<taw> ocaml has ;)
<taw> and it's not on that page ;)
<taw> just check documentation for ocaml
<stefp> I found the slides from the RedHat guy very unlightning
<stefp> he compared OCAML to scheme and C++ pseudo-code
<taw> where ?
<stefp> htat conveyed a lot of information in very few word
<stefp> that was a link in the OCAML site
<stefp> damned I shoul have bookmarked it :(
<taw> google
<taw> that's the only bookmark you need
<stefp> I tried to no avail
<stefp> it does not work for well for slides
Kinners has joined #ocaml
systems has joined #ocaml
gene9 has joined #ocaml
gene9 has quit [Client Quit]
lus|wazze has quit ["\o/ www.minibosses.com \o/"]
systems has left #ocaml []
polin8 has quit [Read error: 54 (Connection reset by peer)]
polin8 has joined #ocaml
polin8 has quit ["Lost terminal"]
polin8 has joined #ocaml
whee has joined #ocaml
Zadeh has joined #ocaml
Kinners has left #ocaml []
reltuk has quit [Read error: 60 (Operation timed out)]
lament has quit ["THIS PUNISHMENT IS NOT BORING AND POINTLESS"]
lament has joined #ocaml
lament has quit ["WEDGIES ARE UNHEALTHY FOR CHILDREN AND OTHER LIVING THINGS"]
two-face has joined #ocaml
skimpIzu has quit [Read error: 54 (Connection reset by peer)]
two-face has quit ["Client exiting"]
lus|wazze has joined #ocaml
systems has joined #ocaml
systems has quit [Client Quit]
reltuk has joined #ocaml
two-face has joined #ocaml
two-face has quit ["Client exiting"]
Vincenz has joined #ocaml
<Riastradh> type t = { f : 'a. int -> 'a } (* What's wrong with this field? *)
<pnou> nothing, for example { f = function x -> List.hd []} has type t
<Riastradh> Oh, wait, no, not that.
<mellum> What's the meaning of 'a.?
<Riastradh> let make : (int -> 'a) -> t = fun f -> { f = f }
<Riastradh> mellum, it's a polymorphic field -- instead of t having the type parametre 'a, f has the type parametre 'a, and therefore you can have two ts of the same type such that f has a different type between them.
<Riastradh> OCaml complains about that make function -- 'This value has type int -> 'a which is less general than 'b. int -> 'b'
<pnou> 'a. int -> 'a means for all 'a, int -> 'a, and int -> 'a means for one 'a, int -> 'a, so the type of f is less general
<Riastradh> Yes, and how do I fix it?
<taw> type a t = { f: a * int -> a } ?
<taw> better ?
<taw> oh
<pnou> why don't you use type 'a t = { f: int -> 'a }?
<taw> no
<taw> ' is not good
<taw> oh
<taw> that . wasn't * ?
<taw> then
<taw> type a t = { f: int -> a }
<taw> hmm
<taw> ok, i don't know any ocaml ;)
<pnou> :)
<taw> type 'a t = { f : 'a -> int }type 'a t = { f : 'a -> int } seems to work
<taw> type 'a t = { f : 'a -> int }
<taw> once ;)
<pnou> yeah! :)
<Riastradh> Then I can't put it in things like exceptions, pnou.
<Vincenz> why not?
<Riastradh> Exceptions can't take type parametres.
<Vincenz> euhm
<Vincenz> both work
<Vincenz> type t = { f : 'a . int -> 'a};;
<Vincenz> pn
<Vincenz> type 'a t = { f : int -> 'a};;
<Vincenz> then using your func definition
<Vincenz> I get an exception from both
mattam_ has joined #ocaml
<Riastradh> type 'a t = { f : int -> 'a }
<Riastradh> let make : (int -> 'a) -> 'a t = fun f -> { f = f }
<Riastradh> ...works for me.
<Vincenz> huh?
<Riastradh> Or did you mean pnou's function in the 'f' field didn't work?
<Vincenz> no they both work
<Vincenz> I didn't say "didn't work"
<Vincenz> so I'm curious why the distinction is importan
<Riastradh> exception Foo of 'a t
<Riastradh> This won't work, because 'a is undefined.
<Vincenz> oh
<Riastradh> exception 'a Foo of 'a t
<Vincenz> andt he second one will ?
<Riastradh> This won't work, because exceptions can't take type parametres.
* Vincenz nods
<Vincenz> but type t = { f : 'a . int -> 'a};;
<Vincenz> that will work cause the type is not parametrizable
<Vincenz> so what I wonder is, why is this allowed?
<Riastradh> type t = { f : 'a. int -> 'a }
<Vincenz> after all it does take a parameter
<Riastradh> is perfectly valid.
<Riastradh> And, indeed, then:
<Riastradh> exception Foo of t
<Riastradh> works.
<Vincenz> yup
<Riastradh> But 'make' does not.
<Vincenz> but, why did they allow this?
<Vincenz> and not the other
<Riastradh> 'The other?'
<Vincenz> well
<Vincenz> why did they allow an exception of a type who contains a parameter and not a parametrizable type?
<Riastradh> It is useful in certain circumstances, such as that which I just described.
<Vincenz> true
<Vincenz> but, hmm
<pnou> this is so useful that you can't do what you want :)
<Vincenz> I know there was an explicit reason not to allow parametrizable types in eceptions
<Vincenz> so I wonder why this -is- allowed
docelic|away is now known as docelic
mattam has quit [Read error: 110 (Connection timed out)]
two-face has joined #ocaml
<two-face> hi
<Riastradh> Hi.
mattam_ is now known as mattam
<Vincenz> eirgh
<Vincenz> ocaml keeps thinking that this general function accepts only exp and not other stuff
lament has joined #ocaml
<Vincenz> mind if I paste?
<Vincenz> it's 9 lines
<Riastradh> Go ahead.
<Vincenz> and print_list f s (ll: 'a list) = match ll with
<Vincenz> | [] -> ()
<Vincenz> | [e] -> f e
<Vincenz> | e::l -> f e; print_string s; print_list l
<Vincenz> it's to print lists of various things
<Vincenz> the f can be passed in to print specific items
<Vincenz> now I use it once to print an exp list
<Vincenz> and later to print a (symbol*exp*pos) list
<Vincenz> This expression has type (symbol * exp * pos) list but is here used with type
<Vincenz> exp list
<mellum> Put it in its own file.
<Vincenz> it's defined in a long list of
<mellum> BTW, the [e] case is redundant, since [e] == e :: []
<Vincenz> let rec print_xxx
<Vincenz> and print_xyz
<Vincenz> and ...
<Vincenz> and print_list
<Riastradh> mellum, no, because print_string shouldn't be called in the case of e :: [], but since that matches e :: l, print_string will be printed.
<mellum> Riastradh: yeah, i just realized that :)
<Vincenz> hmm
<Vincenz> damn
<Vincenz> I should match e::e2::l?
<Vincenz> it complains on line 98 :/
<Vincenz> I guess because of line 83 it tries to prematurely bind the list that is passed in to an exp list
<Vincenz> I don't see why though, the calling of a function shouldn't restrict it's type, should it?
<Vincenz> yup
<Vincenz> apparently with recursive declarations it tries to bind it
<Vincenz> let rec plop = plap print_int 1; plap print_string "a"
<Vincenz> and plap f x = f x;;
<Vincenz> plap print_string "a": This expression has type string -> unit but is here used with type int -> unit
<Vincenz> even if you specificy it should take ('a -> unit) and 'a
docelic is now known as docelic|away
docelic|away is now known as docelic
<Riastradh> Specificy?
two-face has quit ["Client exiting"]
<Vincenz> specify
<Vincenz> sorry
<Riastradh> I'd like to combine a bunch of components in separate files with each their own modules -- say the whole thing is called Lib, and there's a subcomponent A -- I want to be able to reference values in A with: Lib.A.value
<Riastradh> How should I go about doing this?
<Vincenz> well
<Vincenz> yopu could type in Lib.ml
<Vincenz> module A = A
<Vincenz> no?
<lus|wazze> ?
<Riastradh> Reference to undefined global `A'
<Vincenz> hmm
<Vincenz> of course A would have to be defined in A.ml
<Vincenz> otherwise you do
<Vincenz> module A = struct ....end
<Vincenz> inside the Lib.ml file
<Riastradh> A.ml contains ordinary OCaml expressions, not a 'module' definition.
<Vincenz> you have to call it a.ml
<Vincenz> the first letter gets capitalized
<Vincenz> and the module stuff is implicit
<Vincenz> but it has to be a.ml
<Vincenz> not A.ml
<Riastradh> The subcomponents' filenames are all of the format 'Subcompname.ml[i]' and I can reference them stuff as Subcompname.foo in each subcomponent file.
<Vincenz> hmm
<Vincenz> maybe because your makefile says subcompname.ml[i] and you're running windows?
<Riastradh> I'm neither using make nor using Windoze.
<Vincenz> well
<Vincenz> I meant, when you compile
<Vincenz> you type
<Vincenz> ocamlc -c subcompname.ml[i]
<Riastradh> No, I'm using 'ocamlc -c Foo.ml Foo.mli'.
<Vincenz> oh
<Vincenz> then I don't know, sorry
<taw> :)
<taw> details
<Riastradh> What about details?
<taw> but foo.ml is more standard
<taw> than Foo.ml
<Riastradh> It shouldn't matter.
<lus|wazze> it does
<Riastradh> I'm using qualified names in each of the subcomponents and it works fine.
<lus|wazze> it will look for a file called foo.cmi / foo.cma as a compiled object when you reference a module called Foo
<Riastradh> Foo.bar references the value bar defined in Foo.ml.
<lus|wazze> the file must be named foo.ml
<lus|wazze> for it to find references to a member called bar in that file
<taw> Foo.bar references the value bar defined in foo.ml ;)
<lus|wazze> correct^^
<Riastradh> Er, but my filesystem is case insensitive anyways, so it won't matter anyways.
<lus|wazze> it works that way even on windows, where the file system is case insensitive
<Riastradh> How is that possible?
<lus|wazze> windows preserves the case of the filename, it just doesn't use it to distinguish files
<Vincenz> yup
<Vincenz> that's the problem I had
<Riastradh> Windows is irrelevant; I'm not using it.
<Vincenz> I had compile SomeModule.ml
<Vincenz> and it couldn't find the module SomeModule
<Vincenz> now that I compile it as someModule.ml
<Vincenz> it works
<Vincenz> and I work on windows
<Vincenz> it is VERY important how you tell the compiler to compile it
<taw> hehe
<taw> yeah
<taw> windoze is irrelevant
<pnou> that's weird
<Riastradh> Yes, because I'm -not using it-.
<taw> it's used less often than bsd or solaris, and is faaaar from linux
<Vincenz> no it's not irrelevant
<Vincenz> that's why in linux the filenames have to be lowercase firstlettered
<taw> by serious people that is
<Riastradh> How is it relevant to my problem?
<Vincenz> and on operating systems that ignore case
<Vincenz> you should compile it as firstletterlowercased
<Riastradh> OK, fine, I will, but tell me: how the bloody hell is Windows relevant to my problem?
<lus|wazze> because it demonstrates that even on a case-insenstive FS you should compile files as foo.ml rather than as Foo.ml
<taw> it demonstrates that case insensitive filesystems are braindead
* Vincenz nods
<Vincenz> WAHOO!
<Riastradh> lus, it worked perfectly fine before I tried to combine all the modules in one big module.
<taw> someone blocks default.ida, sure - let's httpget DEFAuLt.iDa
* Vincenz grins taw
<taw> hmm
<taw> on my system only lowercase default.ida is redirected to microsoft.com
<taw> maybe i should tweat regexs in apache
<Riastradh> ocamlc -c Foo.mli Foo.ml; ocamlc -c Bar.mli Bar.ml # in Bar.ml, Foo.baz is referenced, and it worked perfectly fine.
<taw> yeah, but it can't hurt if you rename all files to lower case letter first
<Riastradh> It can't hurt but it should also make no difference.
<taw> maybe, maybe not :)
<Vincenz> hmm
<taw> just $ rename 's/A-Z/a-z/g' *
<taw> ;)))
<Vincenz> how do I replace all \n's in to \\n's in a string?
<Vincenz> and \t's with \\t's
<Vincenz> it's for a printing function
<Vincenz> I guess a forloop?
<Vincenz> print_char..
<taw> there was something like String.escape
<taw> not remember it clearly
<Vincenz> thnx :)
pattern_ has quit ["..."]
<Vincenz> Yay!
<Vincenz> My printfunction works correctly
<Vincenz> it prints out an AST exactly like it's made, so I can save it into a file and reload it
<taw> you're still at parsing phase ?
<Vincenz> yes
<Vincenz> I went out
<Vincenz> but
<Vincenz> that time was spent on that printing function
<taw> you could use it better on installing linux and there you have ocamldebug for free ;)
<Vincenz> heh
<Vincenz> still
<Vincenz> it's handy
<Vincenz> print_exp
<Vincenz> generates ocamlcode in the printout to create the AST
<taw> mmm
<taw> does ocaml have universal print function ?
<taw> maybe it already does
<Riastradh> No, but you can cheat and use the Printf.printf garbage.
<taw> Riastradh: how ?
<Riastradh> R-ing TFM helps.
<taw> sure ;)
<taw> i don't have slighties clue how have they implemented printf and how do it know that "%d\n" needs int etc
<Riastradh> camlp4.
<taw> printf is by camlp4??
<Riastradh> I think so.
<Vincenz> I doubt it can tho
<Riastradh> Can what?
<Vincenz> print any structure
<Vincenz> doesn't part of it get lost at compilation?
<taw> noo
<taw> it generates printing function during compilation
<Vincenz> oh
<Vincenz> just need to know how to access them
<Vincenz> ?
<taw> (printf "%d\n") is generated function
<taw> "printf" is better treated as keyword ;)
<taw> that's a bit complex and i don't understand it well
<taw> tfm also doesn't say much
<lus|wazze> actually thats not true printf is just a normal function
<lus|wazze> whats special is "%d\n"
<lus|wazze> which is NOT a string
<lus|wazze> but a format specifier
<lus|wazze> which already contains the type information
<lus|wazze> i.e. in the %d
<lus|wazze> at least thats how I understood it
<Vincenz> heh
<Vincenz> if you look at tfm
<taw> et fmt = (Obj.magic fmt : string) in
<taw> hmm
<Vincenz> "%a" expects a ('b -> unit) and 'b
<taw> wtf is that ?
<Vincenz> so I wonder where it gets the printing functions from
<taw> Obj.magic seems to be the guilty one
<Vincenz> that's camlp4?
<taw> no, that's not camlp4
<Vincenz> where do you see Obj?
<taw> camlp4 is even more evil than that
<taw> in definition of fprintf
<Vincenz> oh found it:)
<taw> so, which manual explains that ?
<lus|wazze> # let x : (int->unit, out_channel, unit) format = "%d";;
<lus|wazze> val x : (int -> unit, out_channel, unit) format = <abstr>
<Vincenz> taw: where do you see the reference to Obj.t?
<taw> ocamlbrowser - printf
<taw> don't say you don't have ocamlbrowser either ;)
<Vincenz> of course I do
<Vincenz> I was looking throug tfm
<Vincenz> I see no Obj.t
<Vincenz> what version do you have?
<taw> oh
<Vincenz> ah!
<taw> type t
<Vincenz> it's TopLoop.print_value
<taw> it just says that here
<Vincenz> I know
<Vincenz> but I don't see Obj.t in Printf
phubuh has joined #ocaml
<phubuh> hey huys
<Riastradh> Hi.
<taw> how to use all these to print expressions ?
<phubuh> in UserInterface.ml, i have the class user_interface. in GraphicalUserInterface.ml, i have the class graphical_user_interface. i want to inherit user_interface, so i have "inherit UserInterface.user_interface foo", but when i compile GraphicalUserInterface.ml, it says that UserInterface.user_interface is unbound
drlion has joined #ocaml
<phubuh> oh. since the source files were named with an initial capital letter, so were the .cmi files, so ocaml couldn't find them
<phubuh> (it automatically lowercases the first letter in module names)
* Riastradh 's problem still persists.
<taw> i read faqs and fms but still no info about that
<taw> how to print arbitrary value
<phubuh> i get an array out of bounds exception, how do i know the context of the faulty call?
<phubuh> taw: you don't have an arbitrary value
<phubuh> you know the type of every value you have
<taw> yeah
<taw> that's why it should be easy
<taw> but is not
<taw> there should be some function
<taw> printme 'a -> unit
<taw> or string_of_any 'a -> string
<taw> that wouldn't even hurt much if i had to use it like printme ( expr : typename)
<lus|wazze> then whats bad about doing print_typename expr ?
<taw> because type may be something like int array or float tree
<lus|wazze> then you do e.g. print_array string_of_int [| 1; 2; 3 |] or something like it?
<taw> there is somethinf like print_array ?
<taw> i can't see such thing anywhere
<Riastradh> taw, Array.iter print_string array
<taw> no, that's no good
<lus|wazze> no but you could easily define it :)
<taw> it should do things like [ ; ] etc.
<taw> and then there are many constructed types
<taw> toplevel already knows how to print them
<lus|wazze> let string_of_array soe x = "[|" ^ String.concat (List.map soe (List.of_array x)) ";" ^ "|]"
<taw> why should i make printing functions every time when they already exist
<lus|wazze> yeah something like that should be in the standard library
<taw> maybe a few lines of perl would be enough
<taw> like ./gen_printme "int array tree"
<taw> hmm
Smerdyakov has quit ["reboot"]
Smerdyakov has joined #ocaml
<mattam> taw: string_of_list elem_to_string_fn delim list is better IMHO
<taw> well
<taw> printme would be the best
<taw> ruby has it, why can't ocaml have it too ;)
gorgias has joined #ocaml
<mattam> lack of overloading i think
<mattam> imperative overloading that is
<taw> doesn't matter
<taw> we can find that out at compile time
<mattam> no way to write print for int's and strings
<mattam> it's a failure of the type system if I understood it correctly
<taw> no
<taw> it should be implemented the same way as toplevel does it
<mattam> toplevel use a hack IIRC
<taw> so ?
<taw> that's good
<taw> we can use the same hack too
<mattam> with installed printers
<taw> it would be wonderful for debugging
gorgias has quit [Client Quit]
<taw> it may be slow and whatnot
<mattam> printf is your friend
<taw> but debugging ocaml stuff would immediately begome way more useful
<taw> no !
<taw> printf can't print even lists
<taw> let alone anything comparable to what toplevel can
<mattam> right
<mattam> this is still the most annoying thing in ocaml
<taw> computer systems generally consist of theoretycally sound base and a couple of hacks that make it 10x more useful
<mattam> :)
pattern_ has joined #ocaml
mattam is now known as frgentoo
frgentoo is now known as mattam
Vincenz has quit []
<phubuh> how would this look like with ocamlopt instead of ocamlc: ocamlc -o deepwood -I +sdl bigarray.cma sdl.cma foo.ml
<phubuh> i tried ocamlopt -o deepwood -I +sdl bigarray.cmx sdl.cmx foo.ml, but i don't get the implementations from sdl
<phubuh> oh, using cmxa instead of cmx solved it
<phubuh> god i love o'caml
jao has joined #ocaml
lus|wazze has quit ["\o/ www.minibosses.com \o/"]
stefp has quit [Read error: 110 (Connection timed out)]
stefp has joined #ocaml
stef_ has joined #ocaml
reltuk has quit [Read error: 110 (Connection timed out)]
jao is now known as jao|zZzZ