gl changed the topic of #ocaml to: OCaml 3.07 ! -- Archive of Caml Weekly News: http://pauillac.inria.fr/~aschmitt/cwn , A tutorial: http://merjis.com/richj/computers/ocaml/tutorial/ , A free book: http://cristal.inria.fr/~remy/cours/appsem, Mailing List (best ml ever for any computer language): http://caml.inria.fr/bin/wilma/caml-list | http://icfpcontest.org/ !!
<Smerdyakov> simon-, this news is both old and uninteresting.
<tyler__> simon-, I know, but it doesnt work. Actually I'm into a bison rule, and opening a let seems not to work
<simon-> all news are old news and no news are good news.
<Lemmih> simon-: Do you have a link to an article about it?
<Smerdyakov> tyler__, what is "opening a let"?
b0nk- has joined #ocaml
b0nk- is now known as tyler___
<tyler___> sorry .... :<
<simon-> Lemmih, google F#
<simon-> Smerdyakov, newbie abstraction
<Smerdyakov> tyler__, what is "opening a let"?
<tyler___> exps : seed rule nb_iter angle length { let sys = {$1, $2, $3, $4, $5} } <--- thats my bison rule, I want it to return a composed type lsystem = { s: string;
<tyler___> r: rules_list;
<tyler___> n: int;
<tyler___> a: float;
<tyler___> l: float;
<tyler___> }
<Smerdyakov> tyler__, of course it won't work! You aren't including the labels, like in kinners's example!
<Smerdyakov> tyler__and you shouldn't be looking for this or other languaeg information in "courses." Use the OCaml manual: http://caml.inria.fr/ocaml/htmlman/index.html
<tyler___> Smerdyakov: sorry for the stupid question, of course I'm using the ocaml documentation as well
tauop has joined #ocaml
<Smerdyakov> tyler__, but this is covered in the language reference, and probably in the tutorial as well....
tyler__ has quit [Read error: 110 (Connection timed out)]
b0nk has joined #ocaml
<b0nk> hi
tyler___ is now known as maym
<tauop> hi
<b0nk> i have a silly question
<b0nk> suppose i've an interface LSystem with a lsystem type declared inside (in the .ml file) as a record
<b0nk> i have a func which returns a LSystem.lsystem record
<b0nk> let blah = func ...
<b0nk> but when i can't access blah.attribute1 for example
<b0nk> Unbound record field label seed
<b0nk> :(
<kinners> record labels have to be fully qualified
<simon-> func sounds funky.
<kinners> {Lsystem.a = ""; ... etc}
<b0nk> hum.. i only want to access one attribute
<b0nk> not to construct the record itself
<kinners> blah.Lsystem.attribute1 then
<b0nk> may i paste the LSystem.lsystem type ?
<b0nk> it's only 5-6 lines long
<Smerdyakov> No.
<Smerdyakov> We all already know what we need to know.
<b0nk> lol
<Smerdyakov> Explain concisely why what kinners has said doesn't help you if you think it doesn't.
<tauop> hummmm
<b0nk> LSystem is the "module" name, lsystem (so LSystem.lsystem) is a record type defined in the Lsystem module. I have a function which returns a LSystem.lsystem record : let thevar = the_func_that_returns_a_lsystem_record() ... I tried thevar.attribute to access one of the attribute of the lsystem record but the compiler doesn't resolve it
<Riastradh> b0nk, and as kinners said, you need to fully qualify attribute names, i.e. you need to write thevar.LSystem.attribute, not just thevar.attribute.
<b0nk> ok
<b0nk> i forgot to explicit every record name in the .mli
<Smerdyakov> This is the second time today that b0nk has explicitly ignored the exact answer to his question from kinners!
<b0nk> that's true
<b0nk> but kinners should have added : "in the .mli" ;P
<b0nk> just kidding
<b0nk> thanks again
Axioplase has quit [Remote closed the connection]
maym has left #ocaml []
CiscoKid has joined #ocaml
tauop has quit ["Leaving"]
kinners has quit ["leaving"]
tyl3r has quit [Read error: 54 (Connection reset by peer)]
tyler has joined #ocaml
KrispyKringle has joined #ocaml
<KrispyKringle> hiya folks. q
<KrispyKringle> quick question; how would i get the pid of the running process? possible?
<KrispyKringle> of the program, that is.
<CiscoKid> Unix.getpid
<KrispyKringle> sweet, thanks.
<CiscoKid> yep
<KrispyKringle> ah, whoops. found it on the website now. :P
<KrispyKringle> so real basic question (i used to use ocaml and havent for a long time--don't know if i ever knew this or not). Anywho, if I have some function foo that returns a string, and i want to print it (using print_string, no?) then I would want to do print_string foo. But it might complain that This expression has type unit -> string but is here used with type string. How would I resolve that?
<KrispyKringle> thanks.
<CiscoKid> What's the code look like around it?
<CiscoKid> BTW, printf works pretty well. :)
<KrispyKringle> printf?
<CiscoKid> Printf.printf "My string: %s\n" somestring
<KrispyKringle> hmm...cool :P
<KrispyKringle> could i put a function in for somestring?
<CiscoKid> Yeah, it's just a function call, but is sort of generated dynamically. It's still statically typed, so %d would cause the compile to fail.
<KrispyKringle> right
<KrispyKringle> intresting.
<Riastradh> The magic is in the type of the first argument. It's not technically a string.
<KrispyKringle> which, the argument in quotes>
<KrispyKringle> ?
<KrispyKringle> ah, i know what im donig wrong. im passing the function instead of what it returns. so if i have a function that returns some string, say, if i do `let foo = myfunc', it assigns foo to the function rather than the value. whoops :P
<KrispyKringle> how do i do it properly?
<KrispyKringle> (and that's why OCaml is capable of Higher Order Functions, is it not?)
<CiscoKid> You invoke the function and pass in the return.
<CiscoKid> What are the parameters to the function?
<KrispyKringle> none.
<CiscoKid> All functions take one parameter and return one argumetn.
<CiscoKid> er, return one value
<KrispyKringle> ah, so if it takes a unit?
<CiscoKid> unit is ()
<KrispyKringle> oh, you go ()
<KrispyKringle> oops
<CiscoKid> You have to pass that in.
<KrispyKringle> thats right
<KrispyKringle> haha, yeah, i got it.
<KrispyKringle> im always bad with syntax.
<KrispyKringle> thanks for the help.
<KrispyKringle> hey, so ocaml supports nested scopes, right?
<CiscoKid> OCaml's not too bad with syntax, although a lot of mine starts looking like scheme after a while.
<CiscoKid> What do you mean by nested scopes?
<CiscoKid> A binding is valid within the let that declared it.
<KrispyKringle> right, but one can do a let inside of a let, and redefine a variable defined outside the let?
<KrispyKringle> well, or define a new one?
<KrispyKringle> i think you can...
<CiscoKid> Hmm...I'm not sure. I don't think I'd want to do that. :)
<KrispyKringle> not usually, no :P
bzzbzz has quit ["[BX] The name's X. gtkBitchX."]
bk_ has quit ["leaving"]
KrispyKringle has left #ocaml []
ne1 has joined #ocaml
ne1 has quit [Client Quit]
bk_ has joined #ocaml
Snark has joined #ocaml
bk_ has quit ["leaving"]
c_ray_c has quit ["bye"]
kosmikus|away is now known as kosmikus
Demitar has quit ["Bubbles..."]
gwe3`wats is now known as vezenchio
bk_ has joined #ocaml
cmeme has quit [Remote closed the connection]
cmeme has joined #ocaml
CiscoKid has quit ["http://lice.codehack.com"]
carm has joined #ocaml
Iter has joined #ocaml
gim has joined #ocaml
_fab has joined #ocaml
vezenchio has quit ["look at you, hacker, a pathetic creature of meat and bone, panting and sweating as you run through my corridors; how can you ]
Iter is now known as shammah
bk_ has quit ["leaving"]
noss has joined #ocaml
bk_ has joined #ocaml
bk_ has quit [Client Quit]
tea has quit [Remote closed the connection]
lucifer has quit ["One day sheep will rule the world"]
bk_ has joined #ocaml
bk_ has quit [Client Quit]
bk_ has joined #ocaml
skylan_ has joined #ocaml
sundeep has joined #ocaml
skylan has quit [No route to host]
<sundeep> hi
<sundeep> i need some help with ocaml, can anyone help?
<Snark> sundeep: you're on irc
<Snark> you're supposed to ask, not ask to ask, or even ask to ask to ask
<sundeep> fine, i'll go ahead then;)
<sundeep> i get this error while compiling my program:
<sundeep> Snark: i have no idea on how i should resolve the error
<Snark> you gave a Gsl_matrix.matrix where a [< `A of float array * int * int | `AA of float array array | `M of Gsl_matrix.matrix | `MF of Gsl_matrix_flat.matrix ] was supposed to go ;-)
<sundeep> i can't understand what `MF of Gsl_matrix_flat.matrix actually means
<Snark> I can't help you much more than that, but messages like "This expression has type foo but is used here with type bar"
<smkl> so you have expr in that place you have an error and you need `M expr
<Snark> well, you have an object whose type was inferred to be that...
<Snark> ooh, that's an idea
<sundeep> so, if they indeed are different types how do i convert one to the other
<Snark> writing (`MF expr) instead of expr ?
<smkl> sundeep: what i said, and to other dir: match expr with `M v -> v
<sundeep> smkl, Snark: i am not sure if i understood what you mean...
<sundeep> but Gsl_* is an external library
<sundeep> here is the function definition:
<sundeep> and here is the code where i call the gemm function:
<sundeep> please look at line 24
<sundeep> guys, have i asked for too much?
<smkl> wait .. are you sure that those interfaces are up to date?
<Snark> I was wondering the same
<Snark> I met the same kind of problem, while typing in the toplevel...
<Snark> relaunching made it work better
<sundeep> Snark: i am compiling the code, so i don't think the toplevel comes into the picture
<sundeep> smkl: i am not sure, now that you ask
<Snark> sundeep: make clean, if no toplevel is involved
<smkl> sundeep: check which version of ocamlgsl you have
<smkl> Gsl_blas.gemm is handled like it was a call to Gsl_blas_gen.gemm
<sundeep> Snark: tried that, no luck:(
<sundeep> smkl: 0.3.3
<Snark> I must admit that I have had strange thing happen, too
<sundeep> smkl: i see what you are saying
<smkl> try checking the types with ocamlbrowser
<sundeep> external gemm :
<sundeep> ta:Gsl_blas.transpose ->
<sundeep> tb:Gsl_blas.transpose ->
<sundeep> alpha:float ->
<sundeep> a:Gsl_matrix.matrix ->
<sundeep> b:Gsl_matrix.matrix ->
<sundeep> beta:float -> c:Gsl_matrix.matrix -> unit
<sundeep> = "ml_gsl_blas_dgemm_bc" "ml_gsl_blas_dgemm"
<sundeep> oops sorry for the flood
<sundeep> but as you can see it does say Gsl_matrix.matrix in the ocamlbrowser
<sundeep> this is my 1st day of coding in ocaml, and i have been stuck with this problem for the last 2 hours:(
<Snark> sundeep: you don't seem to understand the error message
<smkl> ok, then comment everything except the opens in the file, and add "let v = Gsl_blas.gemm", and then compile it normally
<Snark> it says that it is a Gsl_matrix.matrix, but was expecting something else
<smkl> paste the compile line and and add option -i to it.
<smkl> then see what is the type it outputs ...
<sundeep> smkl: it compiles normally
<sundeep> compile line: ocamlopt -o run -I /usr/lib/ocaml/gsl/ gsl.cmxa point.ml vector.ml try.ml -i
<smkl> add it to beginning
<sundeep> the type for v's arguments comes out correct: Gsl_matrix.matrix
<sundeep> ... exactly the same as what i got with ocamlbrowser
<sundeep> Snark: i know that it is expecting a different type, but according to the spec it must be the same type Gsl_matrix.matrix
<smkl> the error must be on the line " let eigval, eigvec = Gsl_eigen.symmv covmat in "
<sundeep> smkl: thanks a lot! god knows how i missed the line number...
<sundeep> i feel like such a fool
<smkl> pastebin seems to mess up the line numbers
noss has quit ["Leaving"]
bk_ has quit ["Leaving IRC - dircproxy 1.1.0"]
Anvil_Vapre has joined #ocaml
<sundeep> i now see what my original doubt was:
<sundeep> what exactly does `M of Gsl_matrix.matrix mean
<sundeep> why is Gsl_vectmat.mat defined as [ `M of Gsl_matrix.matrix | `MF of Gsl_matrix_flat.matrix ]
<sundeep> instead [Gsl_matrix.matrix | Gsl_matrix_flat.matrix ]
<sundeep> smkl?
<smkl> the values have to be tagged
Anvil_Vapre has quit ["Leaving"]
<smkl> [`A of a| `B of b| ..] is the type for polymorhic variants ... there are no types of form [a|b|...]
<smkl> polymorphic
<sundeep> ok smkl, thanks again! i'll lookup polymorphic variants instead of bothering you guys
noss has joined #ocaml
gim has quit []
<sundeep> Snark: thanks! i see now that i missed your point regarding type matching
noss has quit ["Leaving"]
shammah has quit [Read error: 110 (Connection timed out)]
gim has joined #ocaml
Zaius has joined #ocaml
GMsoft_ has joined #ocaml
GMsoft has quit [Read error: 60 (Operation timed out)]
GMsoft_ is now known as GMsoft
GMsoft has quit ["Changing server"]
GMsoft has joined #ocaml
GMsoft has left #ocaml []
mattam_ has joined #ocaml
mattam has quit [Read error: 110 (Connection timed out)]
monotonom has joined #ocaml
gim has quit ["brb"]
kosmikus is now known as kosmikus|away
gim has joined #ocaml
Zaius has quit ["Miranda IM! Smaller, Faster, Easier. http://miranda-im.org"]
<Snark> good night
Snark has left #ocaml []
mattam_ is now known as mattam
Submarine has joined #ocaml
<Submarine> make[1]: *** [pervasives.cmi] Segmentation fault
kosmikus|away is now known as kosmikus
monotonom has quit ["Don't talk to those who talk to themselves."]
vezenchio has joined #ocaml
Submarine has left #ocaml []
shammah has joined #ocaml
bk_ has joined #ocaml
bk_ has quit ["Leaving IRC - dircproxy 1.1.0"]
bk_ has joined #ocaml
monotonom has joined #ocaml
b0nk has quit ["[BX] Get your free warez from ftp://127.0.0.1!"]
skylan_ is now known as skylan
<carm> val open_out_gen : open_flag list -> int -> string -> out_channel. The int value here is the permission of the file if it needs to be created. However the usually three digit representation seems incorrect. Like "755
<carm> will not given owner rwx and others rx
<carm> am I missing a digit here?
<monotonom> 755 in octal.
<monotonom> 0o755
<carm> monotom: ok will try it
<monotonom> http://caml.inria.fr/ocaml/htmlman/manual009.html under the heading "integer literals"
<carm> monotonom: it works, thanks.
afx has joined #ocaml
<afx> hello.. do you guys know of any games written in ocaml?
<monotonom> I consider Coq to be a game.
<afx> :P
<afx> I was reading some thread from 2001 about ocaml possibly being used in games, but no references
<Riastradh> There's a Spaceman Spiff game in OCaml floating around somewhere...
shammah has left #ocaml []
<afx> oh cool