dylan changed the topic of #ocaml to: OCaml 3.09.1 available! Archive of Caml Weekly News: http://sardes.inrialpes.fr/~aschmitt/cwn/ | A free book: http://cristal.inria.fr/~remy/cours/appsem/ | Mailing List: http://caml.inria.fr/bin/wilma/caml-list/ | Cookbook: http://pleac.sourceforge.net/
<Myrizio> hi, just a confirmation, there is no way to work inductively with tuples (like with lists), is there?
<zmdkrbou> nope
<zmdkrbou> you break it or you don't
<Myrizio> zmdkrbou: eh, ok thanks for the answer :)
<Myrizio> still, i think it could be useful (with polymorphic functions)...
<zmdkrbou> mmh it would require a more powerful type system
<zmdkrbou> if you want a 'a * 'b * ... -> 'a * ('b * ...) function
<Myrizio> mh, i was just thinking about 'a -> ('b * ... * 'z) -> ('a * 'a * ... * 'z)
<Myrizio> but anyways yes, probably the type system should learn to match generic tuples to be able to do this...
<zmdkrbou> yes then you can code this yourself ... but you can't go up to an arbitrary high arity
<Smerdyakov> You can with this: http://laconic.sourceforge.net/demo/ :-)
<zmdkrbou> (anyway i never used a tuple of more than 5 or 6 elements)
<Myrizio> eh, i will try to code this as soon as i'll have finished learning ocaml :)
<zmdkrbou> Smerdyakov: :) i suppose you can also use metaocaml
<zmdkrbou> Myrizio: this is trivial code, let f3 (a,b,c) = a,(b,c) and so on :)
<Smerdyakov> I don't think the MetaOCaml approach works as well as mine.
<Myrizio> zmdkrbou: sure, i understand this code, i just tough you was thinking about extending the compiler :)
<Smerdyakov> I only care about two phases: compile time and run time.
<Myrizio> s/tough/tought
<zmdkrbou> huhuhu ok :) this, is not trivial :p
<Myrizio> :)
<zmdkrbou> Smerdyakov: i don't see other phases
<Smerdyakov> zmdkrbou, well, I know next to nothing about MetaOCaml, so maybe that comment was off-target. :)
<zmdkrbou> i know ... the same :) about metaocaml, i thought you were speaking of compilation in general
<Smerdyakov> I believe some of these multi-stage languages allow the runtime creation and execution of programs.
<Smerdyakov> Hmph... having a hard time finding a MetaML research paper.
<zmdkrbou> i don't think there's much
<Smerdyakov> Had to go to an author's personal site..
<Smerdyakov> Indeed, MetaML supports an arbitrary number of stages, according to the first sentence in the first paper on it. :)
<mikeX> Smerdyakov: indeed, but it's type safe from what I understand (metaocaml)
<Smerdyakov> mikeX, Laconic is also type safe.
<mikeX> hm, I have to say I can't make much about it from that demo
<mikeX> is it implemented in ocaml?
<Smerdyakov> No, SML.
<Myrizio> are MetaML stages at compile time? like generic, meta-generic, meta-meta, etc?
<mikeX> I see
<Smerdyakov> Myrizio, I think some are at run time, but I can tell you better when I finish reading their PEPM'97 paper. :)
<Myrizio> uh, ok, thanks :)
<mikeX> poll: has anyone here ever used or would advocate the use of fortran for any type of application?
<mikeX> fortran77 in particular
<zmdkrbou> never use fortran :)
* zmdkrbou wonders if mikeX is in the physics field to even get the idea of using fortran
<mikeX> well I won't be using it, that's for sure, I have a friend who does
<mikeX> he's in engineering
<zmdkrbou> the only thing about fortran is that it has the fastest libraries to work on matrix, floats, etc. i believe
<Myrizio> probably the only thing worse than fortran to program with is assembler
<zmdkrbou> :)
<mikeX> I think what's worse is the fact that he is thinking in fortran to solve his problem, he can't abstract the problem or it's solution in any way
<Myrizio> zmdkrbou: even if it has fast libraries, i'd still prefer to write a 2x slower program in half the time
<mikeX> Myrizio: still, what if your program takes 10 days to execute on a cluster?
<Submarine> Smerdyakov, Howdie.
<Smerdyakov> Submarine, howdie again. :)
jcreigh has joined #ocaml
<Submarine> My experience with physicists/engineers is that they make a lot of programming mistakes (bad choice of algorithm etc.) that may trump the linear speedups obtained by "fast" languages.
<zmdkrbou> boarf, C/C++ is almost as fast even where fortran is the top i believe, but hte solution is in the algorithm
<mikeX> yeap I think that comes from my earlier observation
<Submarine> I mean, if you are really concerned about speed, don't put tests in the innermost loop when you don't have to.
<Submarine> You don't even have to change the algorithm.
* zmdkrbou totally agrees with Submarine
<mikeX> they are never taught how to program right
Submarine has quit ["Leaving"]
<Smerdyakov> Who is?
Submarine has joined #ocaml
Thlayli_ has joined #ocaml
<mikeX> :)
jcreigh has quit ["leaving"]
Thlayli has quit [Read error: 110 (Connection timed out)]
khaladan has quit [Read error: 104 (Connection reset by peer)]
jcreigh has joined #ocaml
jcreigh has quit ["leaving"]
mauke_ has joined #ocaml
mauke has quit [Read error: 110 (Connection timed out)]
dark_light has joined #ocaml
Submarine has quit [Read error: 104 (Connection reset by peer)]
Myrizio has quit ["Leaving"]
mikeX has quit ["zz"]
jcreigh has joined #ocaml
jcreigh has quit ["leaving"]
Revision17 has quit ["Ex-Chat"]
Smerdyakov has quit ["Leaving"]
ketty has quit ["Leaving."]
Revision17 has joined #ocaml
ramki has joined #ocaml
ramkrsna has left #ocaml []
Tachyon76 has joined #ocaml
ulfdoz has quit ["Reconnecting"]
ulfdoz has joined #ocaml
_shawn has quit [Read error: 110 (Connection timed out)]
ulfdoz has left #ocaml []
_shawn has joined #ocaml
ulfdoz has joined #ocaml
ramki is now known as ramkrsna
soupz has left #ocaml []
Quinthius_ has joined #ocaml
ketty has joined #ocaml
Quinthius has quit [Read error: 110 (Connection timed out)]
YASP-Dima has quit [Read error: 104 (Connection reset by peer)]
* ayrnieu creates an Impossible exception, for the case that, applied to a bound and listening PF_INET SOCK_STREAM socket, Unix.accept returns ADDR_UNIX
joshcryer has joined #ocaml
pango is now known as pangoafk
butthead has joined #ocaml
butthead is now known as YASP-Dima
pangoafk is now known as pango
zmdkrbou_ has joined #ocaml
zmdkrbou has quit [Read error: 104 (Connection reset by peer)]
<ayrnieu> http://paste.lisp.org/display/19184 <-- a simple but very ugly TCP echo server. Can anyone suggest neater ways to write this?
revision17__ has joined #ocaml
<ketty> ayrnieu: you can allways use ignore to avoid "this expression should have type unit" warnings..
<ayrnieu> oh, thanks.
<ketty> ayrnieu: are your match statements working as expected?
<ayrnieu> yes, they seem to work.
<ketty> hmm... i have never come to understand how match statements are interpreted..
<ayrnieu> why, do they seem wrong to you?
<ketty> i would go paranoid and surround everything with (...)
<ayrnieu> ah.
<ketty> i mean surround every clause...
<ketty> or begin end
<ketty> how come you use begin end where you use it?
<ayrnieu> is there a way to avoid matching ADDR_UNIX ? I get warnings if I don't, but it's logically impossible.
<ayrnieu> oh, I don't know -- for a while I had syntax errors on the ;; of that expression, and was very confused.
<ketty> if your lazy you could write | _ -> assert false instead
<ayrnieu> ah, cool.
Revision17 has quit [Read error: 110 (Connection timed out)]
JKnecht is now known as Lycurgus
Skal has joined #ocaml
<ayrnieu> wow, is there no List.remove ?
<ketty> no there isn't... you have to use List.filter...
<ketty> i think it is weird that there is List.remove_assoc but not List.remove ...
<flux__> the succinct representation being: List.filter ((<>) element)
<ketty> no... :)
<ketty> or.. wait..
<ketty> sorry.. i am confused :)
<ayrnieu> nice :-)
<ayrnieu> OK, I've written it to this: http://paste.lisp.org/display/19184#1 , which also handles multiple simultaneous clients.
<ayrnieu> thanks for your help. I'll appreciate any other comments you have... tomorrow :-)
<flux__> happy hacking :)
<flux__> that's actually quite nicely written, I wouldn't write it much differently :)
<flux__> you might want to check out, for inspiration, this totally non-commented thingy I wrote some time ago: http://www.modeemi.cs.tut.fi/~flux/software/ioframework.ml
<flux__> (it could look nicer with monads)
Lycurgus has quit [Client Quit]
Snark has joined #ocaml
mauke_ is now known as mauke
mauke has left #ocaml []
slipstream-- has joined #ocaml
zmdkrbou_ is now known as zmdkrbou
slipstream has quit [Read error: 110 (Connection timed out)]
Skal has quit [Remote closed the connection]
mikeX has joined #ocaml
mikeX has quit [Read error: 110 (Connection timed out)]
mikeX has joined #ocaml
Thlayli_ has quit [Read error: 104 (Connection reset by peer)]
Thlayli has joined #ocaml
Thlayli has quit [Read error: 110 (Connection timed out)]
mikeX has quit [Read error: 104 (Connection reset by peer)]
mikeX has joined #ocaml
Tachyon76 has quit ["Leaving"]
Smerdyakov has joined #ocaml
_JusSx_ has joined #ocaml
Schmurtz has joined #ocaml
smimou has joined #ocaml
Submarine has joined #ocaml
pango is now known as pangoafk
pangoafk is now known as pango
mikeX has quit ["leaving"]
bohanlon has quit [Read error: 104 (Connection reset by peer)]
bohanlon has joined #ocaml
exa has joined #ocaml
bohanlon has quit [Read error: 104 (Connection reset by peer)]
bohanlon has joined #ocaml
<_JusSx_> hi ocaml pp
<smimou> hi
<_JusSx_> smimou:
<_JusSx_> where are you from?
<smimou> france
Submarine_ has joined #ocaml
Submarine has quit [Nick collision from services.]
Submarine_ is now known as Submarine
shawn has quit ["This computer has gone to sleep"]
Snark has quit ["Leaving"]
_JusSx_ has quit ["leaving"]
illya23b has joined #ocaml
__DL__ has joined #ocaml
shawn has joined #ocaml
Submarine has quit ["Leaving"]
illya23b has quit ["leaving"]
illya23b has joined #ocaml
lispy has left #ocaml []
multani has joined #ocaml
<ulfdoz> in a let-expression, if I have: "let foo = bar and baz = fcall foo" is foo still inbound in the second expression?
<zmdkrbou> what do you call "inbound" ?
<multani> unbound ?
<ulfdoz> I mean unbound, typo, sry.
<zmdkrbou> foo is not unbound
<ketty> # let a = 1 and b = a;;
<ketty> Unbound value a
<zmdkrbou> seriously ??
<ketty> yes
<zmdkrbou> oh
<zmdkrbou> you forgot the rec
<ulfdoz> yeah, I wondered about, too. Because haskell explicitly has this "and" to have foo bound.
<zmdkrbou> ulfdoz: did you forgot the rec intentionnaly ?
<ulfdoz> Yes. i think so, but it makes sense in this context.
<ulfdoz> Yes, the rec is it! thx.
<ketty> where to put the rec?
<zmdkrbou> let rec a = bla and b = a ;;
<ketty> # let rec a = 1 and b = a;;
<ketty> This kind of expression is not allowed as right-hand side of `let rec'
<zmdkrbou> yes, you can't use mutual recursion to create aliases
<ulfdoz> quite weird with this rec.
* zmdkrbou doesn't really know the criteria for the let rec - and to be valid
<ketty> this gives the same error: let rec a = b and b = 1;;
<ketty> does anything work? :)
<zmdkrbou> it works with function
<zmdkrbou> +s
<zmdkrbou> # let rec a e = 1 and b e = a e ;;
<zmdkrbou> val a : 'a -> int = <fun>
<zmdkrbou> val b : 'a -> int = <fun>
<zmdkrbou> i don't know if it works for any non functional value
<zmdkrbou> (but the use of let rec and is in functions, so ...)
<ulfdoz> ok, now trapped into the "not allowed" thingy :)
<ulfdoz> ok, let's cascade let-in
<zmdkrbou> thinking of it, it's perfectly normal
<zmdkrbou> there's no meaning in defining data with mutual recursion if you don't have infinite data types
<ketty> yes you don't need recursion, since your values only depends on previously defined things...
<ulfdoz> cascaded let-ins compile fine.
<zmdkrbou> you shouldn't use "and" out of the mutual recursion context anyway
<pango> let rec a = 1 :: b and b = 2 :: a ;;
<zmdkrbou> :)
<ulfdoz> ok, I hit the first condition of statically constructiveness.
Schmurtz has quit [Read error: 104 (Connection reset by peer)]
Schmurtz has joined #ocaml
<dark_light> zmdkrbou, but when i want to define two things that are independent of each other (eg. inside a let), shouldn't i use and?
<pango> better not
* zmdkrbou finds more clear to keep and only for mutual recursion
<zmdkrbou> look at the questions we ask ourselves when using and when not needed :p
<pango> that can have unwanted effect (like turning a polymorphic function into monomorphic one, for example)
<dark_light> pango, why? there are some performance issue on this?
<pango> so don't use "and" just because you can
<dark_light> i find it clear enough o.o
<pango> no performance issue, I doubt it changes generated code
<dark_light> pango, i use and to say: "hey, a and b aren't dependent of each other", instead of in that says "b might depends the value of a"
<dark_light> maybe i don't used mutually recursion too much to find useful mark it only for mutual recursion o.o
<ulfdoz> I used and for shortening code.
<ulfdoz> I'm quite sure, it would have had correct semantics with the and. Perhaps compiler just can't decide....
<pango> it's better to stick to things the compile can decide, indeed
<pango> s/compile/compiler/
__DL__ has quit ["sleeping"]
<pango> # let rec id x = x and a = id 3 and b = id "hello" ;;
<pango> This expression has type string but is here used with type int
<pango> # let id x = x in let a = id 3 and b = id "hello" in (a, b) ;;
<pango> - : int * string = (3, "hello")
<dark_light> pango, thats because a and b uses the definition of id
<dark_light> ah
<dark_light> ... o.o
<dark_light> well, intersting
Quinthius__ has joined #ocaml
mikeX has joined #ocaml
Quinthius_ has quit [Read error: 110 (Connection timed out)]
<multani> if I bind a type to a parametric class, could I use a subclass of this type with an instance of this class ?
<ketty> do you mean: type 'a t = 'a class_name ?
<multani> hum no, I mean a class type, "as" in class c = object inherits [t] param_class end;; , where t is a class
<ketty> with parametric class, do you mean type parameters or "constructor"-parameters?
<ketty> i guess type parameters ^^'
<multani> yes :D
<ketty> multani: how do you mean use a subclass of this type with an instance of this class?
<ketty> they are not interchangable...
<ketty> but.. thats probably not what you meant :)
<multani> well, i will try to be more clear :)
<multani> imagine a parametric stack class (like the one which can be found at http://cristal.inria.fr/~remy/cours/appsem/ocaml-objects.html#toc14 )
<multani> imagine I subclass this stack class, and I manually bound the 'a parameter to another class (let's call it D )
<multani> can i use an instance of this stack with an instance of a class derived from D ?
<ketty> yes..
<ketty> if an object of type d_stack is interchangeable with other subtypes of stack?
<multani> euh no /D
<ketty> i guessed so :)
<ketty> i am a bit confused :)
<multani> hmm
<ketty> but you have a class d_stack that is a subclass of stack, right?
<multani> yep
<multani> D1 is a subclass of D, could I use D1 objects with a d_stack object ?
<ketty> i finaly understand what you want :)
<ketty> you have to explictly "cast" the D1 object to D
<multani> (well, s/derived/inherits/ ...)
<multani> ketty, ah, that's why it doesn't work :D
<multani> wonderful !
<multani> hard to explain, but it works :)
<multani> thanks
<ketty> sorry i took so long to understand you..
<multani> well, my english isn't very good, and it was not not very clear at all ;)
<multani> another question, linked to the preceding one
<ketty> yes?
<multani> now, D1 inherits from D, and from another class, and i still want to add it to my d_stack
<ketty> ahh.. D1 uses multiple inherition?
<ketty> that should not matter
khaladan has joined #ocaml
<multani> well, the compiler complains, that only the second type has a method xxx :/
<ketty> hmm... which is the second type? :)
<ketty> D1?
<multani> well, no
<multani> hmm wait
<dylan> an xxx method? I don't wanna know what sort of object that is. XD
<zmdkrbou> :)
<multani> dylan, stop asking me in private what's those objects are, i will not tell you ;)
<dylan> LOL
<multani> i give up :(
Schmurtz has quit ["Plouf !"]
<dylan> give up what? Smoking? XXX methods?
<ketty> multani: if you give a more detailed example, maybe we can help you...
<ketty> (allthou maybe i don't want to know to much details about the XXX methods ^^)
<multani> hmm, i know, but it's rather complicated (to explain, you had already seen what i am capable of :D )
<ketty> you could paste some code to a pastebin...
<multani> let's see ^^
<multani> here it is : http://pastebin.com/672336
<multani> (don't shoot, this is my very first ocaml application :o )
<ketty> ok, can you tell me what error you get, and where you get it? :)
<multani> quickly, it's some kind of xmlrpc server, which will communicate with a python client (throught xmlrpc)
<multani> i'm trying to implements the model of MVC into this "things", the view & the controller will be in the python client
<multani> so, the problem is at the end, line 50
<multani> (the observer and subject class come from the ocaml reference book, chapter 3.5 )
<ketty> where is figure defined?
<multani> the graph, figure and point class are defined in another module
<multani> we have to extend those functionnality, without opening this module
<ketty> point_subject don't seem to be a subclass of figure...
<multani> hmm, figure is an abstract class, point is one class which inherits from figure
<ketty> ok
<ketty> and the exact error that line 50 generates is: ?
<multani> and graph is a graph of figure (in mathematical term)
<ketty> which object has the XXX method? :)
<multani> This expression has type Figure.figure but is here used with type
<multani> < dump_xmlrpc : unit -> XmlRPCTypes.t; .. >
<multani> Only the second object type has a method dump_xmlrpc
<multani> (sorry all, no pr0n there :/ )
<ketty> this is weird...
zmdkrbou has quit [Remote closed the connection]
<multani> i'm not yet really familiar with compiler message
<ketty> can you try: (p : point_subject :> figure) ?
<multani> but as far as I understand, it wants a figure but it got a point_subject ? (or the inverse ?)
<multani> The type constructor point_subject expects 1 argument(s), but is here applied to 0 argument(s)
<ketty> ok, do this: let p = ... in let p2 : figure = (p :> figure) in ...
<multani> hmm, same problem :/
<multani> ("This expression has type ..." problem ;) )
<ketty> i don't understand why this don't work
<multani> am I correct in the declaration of graph_subject ? (and point_subject as well)
<ketty> but a quick workaround could be to add a "to_figure" method in the figure-class
zmdkrbou has joined #ocaml
<ketty> are you 100% sure point is a subclass of figure? could you paste the exact error message?
<multani> hmm, that's all i got :/
<multani> however, point is not directly a subclass of figure, there's another virtual class between (but i don't think it can cause problems)
<ketty> this expression has type point_subject but is here used type figure ??
<multani> the inverse
<ketty> ahh..
<ketty> and the type of graph#add_sommet is?
<ketty> hmm...
<ketty> if you load this in the interactive toplevel and type "graph#add_sommet;;"
<ketty> what type does it tell you it has?
<ketty> maybe there is a problem in the definition of graph..
<ketty> hmm...
<multani> i'll try
JKnecht has joined #ocaml
<multani> we have some unit test with this class, it seems to works, but i'm not really confident in the tests ....
<multani> here is a subset of graph :
<multani> class ['a] graph :
<multani> object
<multani> val mutable sommet_list : 'a sommet list
<multani> method add_sommet : 'a -> unit
<multani> end
smimou has quit [Read error: 110 (Connection timed out)]
<ketty> ok, i might see the problem..
<ketty> try this definition of graph_subject: http://pastebin.com/672367
<multani> i think i already try something like this, let's see
<multani> hum, it fails on line 5 with "The type constructor observer expects 1 argument(s), but is here applied to 0 argument(s)"
<multani> (line numbers from your pastebin)
<ketty> ok : inherit ['a] subject ("graph")
<ketty> and maybe add 'a as a class parameter
<ketty> ok.. now i really se the problem :)
<ketty> in graph_subject you use the "dump_xmlrpc"-method from point_subject...
<ketty> but you are storing figures, not point_subjects...
<multani> yes
<ketty> and figure has no such method
<multani> hmm, i see
<ketty> so, if you want to use that method you cant store just figures...
<ketty> you must store a type that has that method...
<multani> yes, you're right
<multani> the subject class got it, since point_subject (and so on) inherits from it
<ketty> then maybe you could store subjects?
<ketty> or declare another class...
<ketty> dumpable or something :)
<multani> hmm, if i replace by subject, i got a "The type constructor subject expects 1 argument(s), but is here applied to 0 argument(s)" error
<multani> i'll try the dumpable thing ;)
<ketty> i guess the class subject is in the form: class subject param = object ... end
<ketty> so to get access to the object-type it seems like you have to supply a parameter...
<multani> (actually, this is : class virtual ['observer] subject (name:string) =)
<ketty> ooh... yeah... i forgot the the parameter... ^^
<ketty> (and the virtual part)
<ketty> but if you use your orginal version of graph_subject...
<ketty> and just change the cast at line 50 you should be safe
<multani> in what should I cast ? subject ?
<ketty> but you might want to change the names of the type-variables on graph_subject to something less confusing
<ketty> you could try :)
<multani> yes, i kept the name from ocaml book
<multani> :'(
<ketty> we know that we need a type that has at least the dump_xmlrpc method
<ketty> but there could be other method that are needed..
<ketty> it depends on the definition of graph..
<multani> casting to subject raise the same error : "The type constructor subject expects 1 argument(s), but is here applied to 0 argument(s)"
<ketty> ohh... right...
<multani> hmm
<ketty> since i don't know what argument subject expects i cant help you