vinge.freenode.net changed the topic of #ocaml to: OCaml 3.06 released: http://caml.inria.fr/ocaml/distrib.html | http://www.ocaml.org/ | http://caml.inria.fr/oreilly-book/ | http://icfp2002.cs.brown.edu/ | SWIG now supports OCaml
gene9 has joined #ocaml
<Dybbuk> mrvn: Try marshalling?
* gl &
gene9 is now known as gene9_afk
gene9_afk has quit ["Client Exiting"]
<mrvn> thx. found that too.
mmc has quit [No route to host]
olczyk has joined #ocaml
<olczyk> I can't get chameleon set up.
<olczyk> When I compile, I get an error message: >> Fatal error: cannot open pervasives.cmi
<olczyk> It's there. But the compiler just can't find it.
Begbie_ has quit [Read error: 104 (Connection reset by peer)]
Begbie has joined #ocaml
graydon has quit [Remote closed the connection]
mrvn_ has joined #ocaml
mrvn has quit [Read error: 110 (Connection timed out)]
two-face has joined #ocaml
gl has quit [Read error: 104 (Connection reset by peer)]
gl has joined #ocaml
gl has quit [Read error: 113 (No route to host)]
gl has joined #ocaml
systems has joined #ocaml
TachYon25 has joined #ocaml
gl has quit [Read error: 113 (No route to host)]
gl has joined #ocaml
systems has quit [Read error: 110 (Connection timed out)]
karryall has joined #ocaml
<two-face> salut karryall
<karryall> salut !
mmc has joined #ocaml
gl has quit [Read error: 104 (Connection reset by peer)]
gl has joined #ocaml
<two-face> karryall: ?
gl has quit [Remote closed the connection]
gl has joined #ocaml
olczyk has quit []
revanthn has joined #ocaml
Segora has joined #ocaml
<Segora> hi
<revanthn> hi
<two-face> lo
<Segora> I'm trying to link a small test program with the ocaml-mysql library. Unfortunately, it seems I can't find the right options for ocamlc.
<Segora> ocamlc -I /usr/local/lib/ocaml/3.06/mysql -o control db.cmo mysqlstatic.cma -cclib -L/usr/lib -cclib -lmysqlclient
<Segora> Error while linking db.cmo: Reference to undefined global `Mysql'
<Segora> maybe someone could help me?
<two-face> it is seeking for a mysql module i guess
<Segora> yes. there is a META file in /usr/local/lib/mysql/3.06/mysql, which seems to have to do with ocamlfind.
<Segora> ah... i think i found the solution:
<Segora> ocamlfind ocamlc -package mysql -linkpkg db.cmo
<two-face> i don't use ocamlfind
revanthn has quit []
<Segora> two-face: do you use ocamlc directly even for external packages?
<two-face> for external packages, I use the + options
<Segora> how does this work?
<Segora> (ocamlc doesn't list any + options when I do 'ocamlc -h')
<two-face> sorry
<two-face> +I
<Segora> hmm. i suppose this is the same as -I ?
<pnou> i think two-face is talking about -I +mysql
<two-face> pfff
<two-face> yes
<two-face> i'm in the fog :p
<Segora> you're living in london? ;)
<two-face> nah
<Segora> well ok, london has no monopoly on fog *g*
<pnou> two-face, for cameleon, doc/html contains all you need
<two-face> pnou: is there a bug anyway ?
<pnou> i don't think so
<pnou> the makefile contains
<pnou> $(CP) *.html $(JPGFILES) $@
<pnou> $(CP) doc_style.css $@/style.css
<pnou> that sould be what maxence want
<pnou> mmm maybe he wanted a mv
<pnou> i'll ask him
gl- has joined #ocaml
gl has quit ["La foule est une somme d'erreurs qu'il faut corriger."]
gl- is now known as gl
<two-face> bon, j'ai tout ce qu'il faut pour tester spamoracle
<pnou> c'est quoi ça ?
<two-face> un soft anti spam de x leroy
eivuokko has joined #ocaml
<Segora> two-face: statistic spam filtering?
<two-face> Segora: that's it
<Segora> interesting...
<two-face> i gathered 15 megs of spam and 12 megs of nospam
<two-face> got to go
<two-face> BBL
two-face has left #ocaml []
Yurik has joined #ocaml
<Yurik> re
<Yurik> anybody got errors like Program received signal SIGSEGV, Segmentation fault.
<Yurik> 0xdbdbdbdb in ?? ()
<Yurik> when making mixed caml/c code?
MegaWatS has joined #ocaml
<MegaWatS> hi
Yurik has quit [Read error: 104 (Connection reset by peer)]
<MegaWatS> hell I'm impressed with ocaml all over again every day
<MegaWatS> just right now I noticed something REALLY cool about it
<mmc> MegaWatS: what ?
<MegaWatS> it's got to do with the way it handles classes
<MegaWatS> you know how in java, there is this glaring mistake the designers made
<MegaWatS> that you can cast an array of objects, if you could cast the individual object types
<MegaWatS> i.e. if you have a class bar which extends foo
<MegaWatS> and an bar-array, you can cast that into a foo-array in java, which is of course wrong
<MegaWatS> in ocaml, now, of course this doesn't work, as expected
<MegaWatS> but then I started wondering about something
<MegaWatS> and tried the same thing with lists
<MegaWatS> because, lists are immutable - so the error wouldn't occur there
<MegaWatS> so, theoretically, it would be possible - if you have a bar list to cast that into a foo list
<MegaWatS> well, and it WORKS
<MegaWatS> the compiler figures out whether the container structure you use is mutable, and allows the correct kind of casting if it is not
<MegaWatS> I found that really cool :)
<mrvn_> Whats wrong with casting a bar-list into foo-list?
<MegaWatS> nothing
<mrvn_> or array?
<MegaWatS> but when it is an array, it is an error
<mrvn_> why?
<MegaWatS> because an array is mutable
<MegaWatS> suppose you have a bar list
<MegaWatS> ok
<MegaWatS> now you cast that into a foo list
<MegaWatS> now you derive baz from foo
<MegaWatS> but not from bar
<MegaWatS> and create a baz object and put it into index N in your array
<MegaWatS> suppose, for example, the following piece of code (which won't compile of course because ocaml doesn't allow it):
<mrvn_> yes, your foo array.
<MegaWatS> class foo = object method foo = "hello" end;;
<MegaWatS> class bar = object inherit foo method bar = "bar_hello" end;;
<MegaWatS> class baz = object inherit foo method baz = "baz_hello" end;;
<MegaWatS> now the following function:
<MegaWatS> let make_mistake (x : foo error) = x.(0) <- (new baz :> foo);;
<MegaWatS> so far it compiles and works
<MegaWatS> whoops typo
<MegaWatS> that should read:
<MegaWatS> let make_mistake (x : foo array) = x.(0) <- (new baz :> foo);;
<MegaWatS> of course :)
<MegaWatS> ok
<mrvn_> guessed that
<MegaWatS> now if ocaml allowed you to cast a bar array into a foo array
<MegaWatS> you could now do the following:
<MegaWatS> let m = Array.create (new bar) 10 in
<MegaWatS> make_mistake (m :> foo array);
<MegaWatS> m.(0)
<MegaWatS> now m.(0) contains a baz, even though it is statically typed not to
<MegaWatS> but ocaml won't allow the bolded part
<mrvn_> same with lists
<MegaWatS> of course, I didn't even for a minute expect that it would :)
<MegaWatS> no, lists are immutable
<mrvn_> you can setbang them
<MegaWatS> not in ocaml
<mrvn_> not? hmm. ok
<MegaWatS> if you could, of course, then lists wouldn't be immutable anymore, and to allow it would be an error again
<MegaWatS> but what's really nice about the way ocaml handles this is that, it figures out by itself whether the structure you use is mutable or not
<mrvn_> You can do a simple List.iter (fun x -> x :> foo) foo_list
<MegaWatS> of course but that doesn't do anything
<mrvn_> That gives you a new list with casted objects.
<MegaWatS> you mean List.map
<MegaWatS> of course
<mrvn_> Which wrks for arrays too.
<MegaWatS> but, so what?
<MegaWatS> yes
<mrvn_> How doesocam figure out if something is mutable?
<mrvn_> s/ocam/ ocaml/
<MegaWatS> well by the definition
<MegaWatS> I did, for example, as an experiment, define my own list datatype:
<MegaWatS> type 'a my_list = Cons of ('a * 'a my_list) | Nil;;
<mrvn_> everything is thats not a reference or class?
<MegaWatS> which is immutable
<MegaWatS> and ocaml allowed it
<MegaWatS> basically, yes
<MegaWatS> everything that's not a (mutable) record or class
<mrvn_> java is even worse with casts. Most conainers accept any object. If you need a typesafe container you have to duplicate the code for each type.
mrvn_ is now known as mrvn
<MegaWatS> yeah
<MegaWatS> java sucks :/
<mrvn> Do you have an idea how to write enums in ocaml?
<MegaWatS> erm :)
<MegaWatS> type foo = Bar | Baz | Qux;;
<MegaWatS> that`s really the easiest thing in the world in ocaml
<mrvn> I need a mapping from type foo = Bar | Baz | Qux;; to 0,2,3
<mrvn> 01,2
<mrvn> args, 0,1,2
<MegaWatS> let to_int = function Bar -> 0 | Baz -> 1 | Qux -> 2;;
<MegaWatS> or you work with constants and abstract types
<mrvn> something that works magically.
<MegaWatS> there isn't anything I'm aware of ...
<mrvn> something that generates the to_int function for a given type.
<MegaWatS> you have to remeber, enum types in ocaml are a bit more complicated than in C because they are, at the same time, unions
<mrvn> ocaml internaly must use some mapping to int in the object. Couldn't one marshal it and read that field from the string?
<MegaWatS> module AnEnum : sig type abstract val make : int -> abstract val take : abstract -> take end = struct type abstract = int let take n = n let make n = if n >= min and n <= max then n else fail_with "blahblah" end;;
<MegaWatS> well ocaml sometimes needs to box constructor values, when they contain arguments
<MegaWatS> so no, it's not quite exactly the same thing as an int
<MegaWatS> what's the problem with writing a
<MegaWatS> conversion function?
<mrvn> extra work.
<MegaWatS> hm
<MegaWatS> well but not much I guess :)
<MegaWatS> what do you need it to be converted into an int for?
<mrvn> at least the compiler warns if you miss one or mistpye one.
<mrvn> mldonkey, network protocol.
<MegaWatS> theoretically, you COULD use Obj.magic for that, but I would advise against it
<MegaWatS> at least, with a hand-written conversion function it is safe
<mrvn> Problem is I would need an instance of the type to get the int of it.
<MegaWatS> ?
<MegaWatS> what do you want to do?
<MegaWatS> brb
<mrvn> For incoming data I have the int and need to match that with the number of the constructor.
<mrvn> 2 -> read_REQUEST_from_socket socket
<mrvn> something like that.
<mrvn> number(Request) -> read_REQUEST_from_socket socket would be nicer.
<mrvn> But to make a Request for number to convert to int I would need dummy data for the Request.
<mrvn> It would be better to have a const for each possible Constructor.
<mrvn> let requestID = 2 and queryID = 3 and ... in
<mrvn> But then its not safe anymore.
<MegaWatS> you can hide the implementation with the module signature
<MegaWatS> and make the type abstract
<MegaWatS> i.e.
<MegaWatS> module AbstractT : sig
<MegaWatS> type t
<MegaWatS> val foo : t
<MegaWatS> val bar : t
<MegaWatS> ...
<MegaWatS> val baz : t
<MegaWatS> val of_int : int -> t
<MegaWatS> val to_int : t -> int
<MegaWatS> end = struct
TachYon25 has quit ["bez ki³y nie ma zaliczenia (z prawd studentek AM)"]
<MegaWatS> type t = int
<MegaWatS> let foo = 1 and bar = 2 and ... and baz = N
<MegaWatS> let of_int n = if n>=1 && n<=baz then n else invalid_arg "of_int"
<MegaWatS> let to_int n = n
<MegaWatS> end
<mrvn> but then you can still have foo=1 bar=1 and baz=1
<MegaWatS> not if you don't do that in your module
<MegaWatS> why you would want to, I don't know
<mrvn> someone has to write up the numbers and he can get it worng.
<mrvn> wrong
<MegaWatS> hmm
<mrvn> The problem is mainly to prevent different people from using the same numbers.
<MegaWatS> I don't think that's really a problem
<MegaWatS> hmm
<MegaWatS> oh that's of course a protocol problem
<MegaWatS> it has nothing to do with the language
<MegaWatS> in C you could still have different peopkle start with eg an enum like
<mrvn> no, but ocaml doesn't have a way to prevent it as enums have in C.
<MegaWatS> enum enum1 { foo, bar, baz };;
<MegaWatS> and then person 1 changes the source to look like
<mrvn> Of cause you can only have one enum.
<MegaWatS> enum enum1 { foo, bar, baz, qux };;
<MegaWatS> and person 2 to
<MegaWatS> enum enum1 { foo, bar, baz, quoz, barax };;
<mrvn> That would be alright.
<MegaWatS> well then, what`'s the problem?
<MegaWatS> in both cases, you have to assign unique numbers to each constructor
<mrvn> In your case the person would compile both client and gui and they would use the same numbers.
<MegaWatS> yes, of course
<MegaWatS> because they use the same module
<MegaWatS> as posted above
<mrvn> The problem comes when person 1 and 2 merge their code and forget that they have overlaps in their numbers.
<mrvn> With a single enum the numbers would change but be uniq.
<MegaWatS> erm... yes? :)
<MegaWatS> so, what's different in ocaml?
<mrvn> you can't let the compiler generate uniq numbers.
<MegaWatS> oh
<MegaWatS> well you simply do let foo = 1 let bar = foo + 1 etc
<mrvn> I was hoping to do something more magic.
<MegaWatS> hm well the compiler can't do EVERYTHING :)
<MegaWatS> YOU have to choose some sort of external representation if you want to do a network protocol
<mrvn> Is the mashaling datastream defined somewhere?
<MegaWatS> or you simply use marshalling
<MegaWatS> I think it's supposed to be abstract
<MegaWatS> but I guess you could look at the sources of the module
<mrvn> unless they change it with the next ocaml version.
<mrvn> I think I will write a protocolNumbers.ml and hope that everyone can count.
<MegaWatS> no I think it's supposed to be stable, as it is supposed to be used to exchange ocaml data
<MegaWatS> yeah you do that :)
<MegaWatS> I don't honestly see where problems are supposed to come into it
<MegaWatS> simply hide everything behind an appropriate signature, and when it needs extension do that inside that module; the outside shouldn't even be concerned with that then
<mrvn> Do you have an idea whats the best way to notify a client about changes in the servers datastructures at regular intervals (but not every change, just from time to time)
<mrvn> Atm it send changes out far too often.
<MegaWatS> well that's not my area of expertise, but naively I would do it with a buffer which accumulates changes, and when it overflows they are sent out and the buffer os cleared
<MegaWatS> ie
<MegaWatS> type change
<MegaWatS> let buf_size = so_and_so
<MegaWatS> let buf : change option array = Array.create None buf_size
<MegaWatS> let change_count = ref 0
<MegaWatS> and then incr change_count; if !change_count >= buf_size send_out_changes(); change_count := 0
<mrvn> I have to combine changes to the same object.
<MegaWatS> well that makes it a bit more complicated, of course, but the principle should still hold
<mrvn> A set of the objects ID * the object should do.
two-face has joined #ocaml
<mrvn> Buffering the objects would just delay the send but not reduce the amount.
<two-face> hi mrvn
<mrvn> Hi two-face
<MegaWatS> ah I see I misunderstood what you meant
<MegaWatS> ok
<mrvn> I have a download counter for each file. That changes say 100 times a second. Sending one update a second is enough though.
<karryall> two-face: oui ,
<two-face> oui ?
<karryall> two-face: tu voulais me dire qqch il y a 2-3 heures :)
<two-face> hmm
<two-face> karryall: j'ai commencé il ya quelques temps un binding xlib en C pour ocaml (pas ffi)
<karryall> oula, c'est du boulot
<two-face> du côté du C ça va
<two-face> par contre, je ne sais pas trop comment organiser mes modules en ocaml
<karryall> ou est le probleme ?
<two-face> le découpage en fichier de manière logique
<two-face> en gros les fichier Xlib.h contient la majorité
<karryall> je crois que fabrice le fessant avait fait un truc xlib aussi
<two-face> oui en ocaml
<karryall> ah oui, il a implemente le protocole X en caml
<karryall> et alors, c'est pas bien ?
<two-face> bah X ça évolue quand même
<karryall> oh ?
<karryall> ca fait un bout de temps qu'ils en sont a la version 11 quand meme
<two-face> ils rajoutent des extensions etc
<karryall> hum
<two-face> je préfère carrément des bindings
<karryall> c'est plus simple a ecrire, c'est sur
<karryall> bah, si t'arrives pas a decouper en modules, ne decoupes pas !
<karryall> fait un seul gros modules :)
<two-face> hmm
<two-face> j'ai appris comment faire marcher les coercisions
<karryall> tu fais de l'objet ?
<two-face> non, c'est pour les types abstrait simples
<two-face> euh non
<two-face> les variants polymorphes
<karryall> ah, ouf
<two-face> par contre, j'ai eu du mal à trouver comment ça marchait
<two-face> c'est quasiment pas documenté
<two-face> les type -'a
<karryall> ca, c'est les annotations de variance
<two-face> type -'a obj
<karryall> ils en parlent dans la premiere partie du manuel, non
<two-face> ya un tutoriel la-dessus ?
<karryall> sinon, la reference c'est lablgtk
<two-face> un tout petit peu
<two-face> mais sommaire
<karryall> ouais, t'as raison
<karryall> y'a pas grand-chose
<two-face> ya 3 lignes dans la deuxième partie du manuel
<karryall> mais y'a pas grand-chose a dire non plus
<two-face> sur la référence du langage
<two-face> bah c pas évident
<two-face> enfin, je ne trouve pas toujours évident de saisir comment s'en servir
<karryall> attends, y'a 5 lignes
<karryall> enorme !!
<two-face> arf
<karryall> bah, deja c'est pour les types abstraits parametres
<karryall> c'est pas _hyper_ courant quand meme
<two-face> bah c nécessaire à priori pour le sous-typage de types polymorphes
<karryall> mais t'es oblige d'utiliser des variants polymorphes ?
<two-face> bah
<two-face> par exemple
<karryall> non je dis une connerie, c'est pas que pour les variants polymorphes
<two-face> Window est un Drawable
<two-face> donc quand on passe en paramètre un Drawable
<two-face> dans une fonction
<two-face> on doit ouvoir passer un Window aussi
<karryall> bah tu fais comme lablgtk
<two-face> il fait ça
<two-face> par contre, j'ai une autre solution
<two-face> si type drawable = int32
<two-face> je peux faire type window = drawable
<karryall> ? ben c'est pas pareil
<karryall> la les types sont egaux
<two-face> bah c le cas en C en fait (dals le code le Xlib)
<two-face> par contre, le code est moins strict
<karryall> j'connais pas tres bien Xlib
<karryall> pnou: faut que je me casse la mais ca m'interesse ton truc, on en reparle
<two-face> vous parlez de quoi ? :)
<karryall> ah non mince
<karryall> c'est a two-face que je cause
<karryall> zut
<karryall> bref
<two-face> qu'est ce qui t'intéresse ? :)
<karryall> ben ton interface xlib
<two-face> je vais mettre mon code sur savannah ou équivalent
<karryall> ok
<karryall> bon, a+
<two-face> a+
<mrvn> What did you just talk about?
<mrvn> two-face: if your drawable is a X11 drawable that should be Int64
<mrvn> shouldn't it?
<two-face> back
<two-face> mrvn: it is int32 in X.h
<two-face> mrvn: sorry if you couldn't read
<Segora> technical french can be rather hard to grasp ;)
<two-face> well, sometimes we are just fed up speaking english
<Segora> i understand. when everybody in the channel understands german, I revert to that, too.
<two-face> i love French after all, why you I always speak English
<two-face> I'd love also to speak German or italian sometimes
<Segora> esperanto is also very interesting
<two-face> hmmm
<Segora> and of course: ocaml *g*
<two-face> esperanto failed to achieve what he was meant to be
<Segora> Hmm? Esperanto is alive, albeit small.
<two-face> it was replaced by english
<Segora> interesting perspective. when it was never really there, how could it be replaced. ;)
<two-face> bah :)
<Segora> :)
<two-face> I don' t want the english-über-alles future
<MegaWatS> why not?
<two-face> because there are many other cultures
<Segora> and because it gives native english speakers an advantage over others.
<two-face> of course
<two-face> as a European citizen, I can tell that Europe is a set of different cultures
<MegaWatS> language does not have to be the same thing as culture ...
<two-face> our langage is part of our culture
<Segora> plus an inefficient administration...
<MegaWatS> and the advantage of native english speakers can be minimized by teaching english from very early on
<Segora> language and culture can not be divided. you have to understand both.
<two-face> of course
<two-face> it's nice to go abroad and to try to adapt and learn for your difference
<two-face> any got to go
<two-face> Bye
two-face has left #ocaml []
eivuokko has quit ["FOE from client"]
<MegaWatS> how do I set a tooltip for an element in lablgtk?
<mrvn> I don't know any french and since you don't know german english is the way to go.
<MegaWatS> ich kann aber deutsch :)
<mrvn> I think english is one of the easiest languages so its a good common language.
<MegaWatS> yes I agree
<mrvn> ja du vieleicht aber wer noch?
<MegaWatS> ka :p
gl has quit [Read error: 104 (Connection reset by peer)]
<MegaWatS> so nobody knows? :(
<Segora> ich
<mrvn> How do you zero extend in printf? I don't want it to strip leading zeros.
<Segora> <- German, English, French (descending order of proficiency)
<smkl> MegaWatS: let tooltips = GData.tooltips () in tooltips#set_tip btn ~text:"Tip"
<MegaWatS> "%0<size>d"?
<MegaWatS> ah thanks
gl has joined #ocaml
<MegaWatS> I'll have to look in GData <.-- didn't think of that
<MegaWatS> I was browsing GMisc and GObj and GWindow
<smkl> hmm, perhaps btn#coerce
<MegaWatS> ?
<smkl> tooltips#set_tip is not polymorphic
<smkl> so you need to coerce
<smkl> supposedly an ocaml program has won icfp contest
<mrvn> Is there a function that converts a time difference into a string?
<mrvn> Something that respect localisation hopefully.
<MegaWatS> I don't know of anything sry
<MegaWatS> hmm
<MegaWatS> why does it display the tooltip at the BOTTOM of my widget
<MegaWatS> instead of below the cursor? :|
<mrvn> in an extra bubble or in the task-bar at the bottom?
<MegaWatS> in an extra bubble, but below the widget
<MegaWatS> ie
<mrvn> Looks like it deiplays it below the object you point at (in mldonkey)
<MegaWatS> hm
<mrvn> Wich I rather like.
<MegaWatS> that sucks, because my widget is a kinda large drawing area
<mrvn> With other progs the bubble is allways in the way.
<MegaWatS> and I dynamically set the tooltip when the displayed object changes
<mrvn> Add a status bar at the bottom and display it there.
<MegaWatS> is there no way to make it display the tooltip below the cursor?
<mrvn> in gtk sure, you find it
<MegaWatS> oh I see it is controlled by the gtk theme
<MegaWatS> hmm
Yurik has joined #ocaml
<Yurik> re
gl has quit [No route to host]
* Yurik is developing new wrapper for BerkeleyDB
<mrvn> How do I right justify columns in lablgtk?
<MegaWatS> dunno :(
* Yurik will be back later
Yurik has quit ["Leaving"]
Montaigne has joined #ocaml
gl has joined #ocaml
<Montaigne> lut
<mmc> is there ocaml manual in info format ? (for emacs)
<mrvn> use the w3-mode :)
<mmc> on what?
<mrvn> the html dokumentation
<mmc> that's sure, but which one ?
<mmc> the o'reilly book ?
<mrvn> mmc: debian has a ocaml-doc package
<mmc> i'm on gentoo.
<mrvn> its the same as the online doku bt not the o'reilly book
<mrvn> yes
<karryall> mmc: the standard library modules in info format : http://oandrieu.nerim.net/ocaml/ocaml.info.tar.gz
<mmc> ok, now the emacs ocaml-mode.el ...
<mrvn> I prefer tuareg
Montaigne has quit [Connection timed out]
irc has joined #ocaml
irc is now known as fabian2
fabian2 has quit ["Leaving"]
fabian2 has joined #ocaml
<fabian2> hello hope it works this time
<fabian2> i have a small question about ocaml
<fabian2> someone awake?
<mmc> i'm just learning it.
<MegaWatS> ask away
<fabian2> perhaps you can answer anyway, what i have is a small program which can be compiled and parses command line argumets, i now want to run it in ocaml and therefore have to call main
<fabian2> but i couldnt figure out how to call it with arguments
<fabian2> i always get something like this
<fabian2> This expression has type string but is here used with type unit
<MegaWatS> ?
<fabian2> and i couldnt find a description of unit
<MegaWatS> usually you access the command line arguments via
<MegaWatS> Sys.argv
<fabian2> yes that works
<MegaWatS> unit is the type which consists only of a single value, ()
<fabian2> but only if i compile it
<MegaWatS> it is the default return type for statements and procedures
<MegaWatS> usually you should do it something like
<MegaWatS> let main args = ...
<MegaWatS> let _ = main Sys.argv
<MegaWatS> and then, when you want to test it from the toplevel
<MegaWatS> you canb simply call main [| put your arguments here |]
<fabian2> with the | ?
<MegaWatS> can you post the expression where the error occurs?
<MegaWatS> yes
<MegaWatS> [ a; b; ..; z ] is a list
<MegaWatS> [| a; b; ...; z |] is an array
<MegaWatS> (a,b,c,...,z) is a touple
<MegaWatS> { a=a; b=b; ...; z=z } is a record
<MegaWatS> etc :)
<fabian2> may i post the program? its 10 lines
gl has quit [Read error: 113 (No route to host)]
<MegaWatS> just post the line where the error occurs
<MegaWatS> that should suffice
<fabian2> main [| "test"; |];;
<fabian2> e.g.
<MegaWatS> without the semicolon
<MegaWatS> ie main [| "test" |]
<fabian2> main [| "test" |];;
<fabian2> This expression has type string array but is here used with type unit
<MegaWatS> well then main takes a unit as argument I guess
<MegaWatS> I thinkj you defined main as
<MegaWatS> let main () =...
<MegaWatS> ?
<MegaWatS> because [| "test" |] is a string array :)
<fabian2> yes, and this works if comoiled
<fabian2> so ./a.out test1 test2 gets passed as arguments
<MegaWatS> of course it works if compiled, as I guess you nowhere have the line main [| "test" |] in it
<fabian2> yes
<MegaWatS> so what is it you want to do?
<MegaWatS> you want to test it in the toplevel?
<MegaWatS> then you'll have to change it a bit
<MegaWatS> so that your "main" function gets the command line arguments passed as an argument
<fabian2> i want a program which can be compiled and parses arguments also be able to run in ocaml and there call it with main arg1, arg2...
<MegaWatS> well then define main to take this argument
<MegaWatS> ie
<MegaWatS> let main args = ...
<MegaWatS> let _ = main Sys.argv
<MegaWatS> and then use args to access the arguments
<MegaWatS> then, you cann call main [| "blah"; "Bleh" |] in the toplevel ...
<fabian2> hmm thats bad i would rather prefer something like set args ... like in gdb
<fabian2> else i would always have to change the program when i compile it or use it in the interpreter
<MegaWatS> why?
<MegaWatS> no?
<MegaWatS> you simply do a
<MegaWatS> let _ = main Sys.argv
<MegaWatS> to call it with teh command line arguments :)
<MegaWatS> you see Sys.argv is the array of the command-line arguments
<MegaWatS> main is a function
<MegaWatS> if you define main like this:
<MegaWatS> let main args = ...
<MegaWatS> then you can call it either like this:
<MegaWatS> main [| "blah" |]
<MegaWatS> or like this:
<MegaWatS> main Sys.argv
<fabian2> ohh i see let me try
<fabian2> hmm what is the cwd when run inside of ocaml?
<MegaWatS> wherever you started ocaml from? :|
<fabian2> hmm i get
<fabian2> # main [| "a.out" |];;
<fabian2> Enter file name
<fabian2> - : unit = ()
<fabian2> ohh wait
<fabian2> i think i have it
<fabian2> no dodnt work
<MegaWatS> ?
<MegaWatS> what do you want to do?
<MegaWatS> I think you wanted to give it command line arguments
<MegaWatS> try
<fabian2> just test if the file which is given as arg exist and print out something
<MegaWatS> main [| ""; "a.out" |]
<fabian2> yes but if i test it in ocaml i have to give it parameters onj my own
<MegaWatS> Sys.argv.(0) is usually not used, or rather, contains the application binary :)
<fabian2> yes thats what i thought was the error if run as program it has as first parameter the filename itself
<MegaWatS> [00:45:43] <MegaWatS> try [00:45:57] <MegaWatS> main [| ""; "a.out" |]
<fabian2> Enter file name
<fabian2> - : unit = ()
<fabian2> ut it should print File found
<MegaWatS> well then the program itself doesn't seem to work :)
<fabian2> yes maybe, can i post it
<MegaWatS> do so
<fabian2> let main args =
<fabian2> Printf.printf "Enter file name\n";
<fabian2> if not (!Sys.interactive) then
<fabian2> for i = 0 to Array.length(args) -1 do
<fabian2> let name = args.(i) in
<fabian2> if Sys.file_exists name then
<fabian2> begin
<fabian2> Printf.printf "File found\n";
<fabian2> end
<fabian2> done;;
<fabian2> main Sys.argv
<fabian2> thats how the file looks like, besides it doesnt do anything usefull yet
<fabian2> if compiled it works
<MegaWatS> theres several things
<fabian2> i then pasted this in ocaml except the main Sys.argv line and want to start it by hand
<MegaWatS> first of all, OF COURSE it always prints the Enter file name
<MegaWatS> because you put it outside of the if ...
<MegaWatS> I don't really see what that if is doing there, anyway
<MegaWatS> also, you loop through the array starting from 0 ... I suppose you only want to use the entries starting from 1
<MegaWatS> seeing as Sys.argv.(0) is the program file name :)
<MegaWatS> try somethiong like
<MegaWatS> or rather, simply remove the unnecessary stuff you put around there
<MegaWatS> !Sys.interactive is true if you run it in the toplevel
<MegaWatS> so it will never execute the loop there
<fabian2> ahh okay
<MegaWatS> do it like this: let main args = for i = 0 to Array.length args - 1 do ... done
<fabian2> that it doesnt do something useful was clear to me
<MegaWatS> let _ = if not (!Sys.interactive) then main Sys.argv
<MegaWatS> this way, it will work both ways automatically
<MegaWatS> ie compiled and in the toplevel
<fabian2> whats that let _ all about
<MegaWatS> let introduces a new name
<MegaWatS> it is like a constant definition in other languages
<MegaWatS> ie
<MegaWatS> let foo = some expressen
<MegaWatS> expression, even :)
<MegaWatS> or
<MegaWatS> like for example
<MegaWatS> let pi = 3.14159265
<fabian2> yes i know just wondering about _; i did some scheme already
<MegaWatS> let test_string = "hello world"
<MegaWatS> well _ is just a name that is ignored
<MegaWatS> ie it evaluates the expression, but binds it to _, i.e., no name at all
<fabian2> okay good, next queston is why did they use not (!Sys.interactive) in the example
<MegaWatS> so let _ = print_string "Hello, World!\n"
<MegaWatS> probably so it doesn't execute right away when it is loaded into the toplevel
<fabian2> ahh yes i remember i have seen _ in recursive functions already
<MegaWatS> but ocaml is really not very much like scheme
<MegaWatS> in scheme, there are variables
<MegaWatS> whereas in ocaml,. all name bindings are constants
<MegaWatS> you have to introduce mutable data structures to create variables
<fabian2> yes i am missing all the '
<MegaWatS> quoting? that should be no problem
<MegaWatS> you can easily do everything you can do with that in ocaml
<MegaWatS> simply do [ a; b; ..; z] for a list for example is exactly like backquoting in scheme
<MegaWatS> ie like `(,a ,b ... ,z)
<MegaWatS> the major difference, as I said, lies in the concept of lexical binding vs variables
<fabian2> yes but in scheme it would be [ 'a; 'b; ... 'z ] or it would evaluate them immediately
<MegaWatS> in scheme, you have set!
<MegaWatS> and (define ...) replaces an old value
<MegaWatS> ie
<MegaWatS> if you do
<MegaWatS> (define a 17)
<MegaWatS> ;; define some functions which depend on a
<MegaWatS> (define a 12)
<MegaWatS> if I remember my scheme correctly, that second define works, then, exactly like a set!
<MegaWatS> there is, however, no set! in ocaml
<fabian2> ah okay
<MegaWatS> you can do the following:
<MegaWatS> let a = 17
<MegaWatS> (* something something something*)
<MegaWatS> let a = 12
<MegaWatS> but it isn't the same thing
<MegaWatS> it is more like
<MegaWatS> (let ((a 17)) ;; something
<MegaWatS> (let ((a 12))
<MegaWatS> ;;...
<MegaWatS> ))
<MegaWatS> i.e. it is a rebinding
<MegaWatS> it only hides the previous definition
<fabian2> okay i see
<MegaWatS> this is imho the major difference between languages like scheme and languages like ocaml, sml, ...
<fabian2> hmm the index of the ocaml system documentation is not very helpful, i want to find the syntax of a for statement
<MegaWatS> it should not be difficult to find
<MegaWatS> I never use the index though
<MegaWatS> but anyway the correct syntax is
<MegaWatS> for name = expression to expression do expression done
<MegaWatS> or
<MegaWatS> for name = expression downto expression do expression done
<MegaWatS> and there is no such thing as a statement in ocaml, only expressions and definitions :)
<MegaWatS> a for statement is an expression which returns ()
<MegaWatS> like all statements
<fabian2> aha
<fabian2> okay if you search for expressions you find it soon
<fabian2> thanks
<MegaWatS> np
<fabian2> hmm well not quite done :) this one i should find out by myself but the first steps are hard
<MegaWatS> they always are
<fabian2> if run from shell it has argv 0 as program name and when run in ocaml i want to give it only the list of arguments so the solution would be to do main Sys.arv(1)...end
<fabian2> hope you got what i mean, my loop runs from 0 to length -1 so I have to cut of the first paramater
<MegaWatS> Array.sub
<MegaWatS> Array.sub arr 1 (Array.length arr - 1)
<MegaWatS> Array.sub array low count returns the first count elements from array arr , starting at index low, as a new array
<MegaWatS> so for example
<MegaWatS> main (Array.sub Sys.argv 1 (Array.length Sys.argv - 1))
<fabian2> kay thanks a lot, I will now try to do the next steps on my own
<MegaWatS> hf
<pnou> icfp winners used ocaml, yeah :)
<MegaWatS> \o/
<MegaWatS> link?
<MegaWatS> thx
<MegaWatS> oh, was that the contest with the virtual "robot" package-carrying contest?
<pnou> yes
<MegaWatS> I see :)
gene9 has joined #ocaml
gene9 has quit [Client Quit]