smkl 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
denshi has joined #ocaml
mattam_ has joined #ocaml
mattam has quit [Nick collision from services.]
mattam_ is now known as mattam
denshi has quit ["leafChat IRC client: http://www.leafdigital.com/Software/leafChat/"]
<mattam> do you think it is possible to specify a particular .so version to gcc (under ocaml) ? debian uses a years old library (libpq.so.2) but has the new one installed for me too look at.
<mattam> (i tricked ld by making a local symlink to the one i wanted and using -L and -l but that's not very clean)
<Demitar> mattam, well by definition it's not a lot more "clean" to pass a flag to gcc. ;-)
<mattam> what's the Debian way then ? ;)
<Demitar> Well I'd say using another .so than the one the linker chooses is a tad unclean no matter how you do it. :)
<Demitar> You're free to disagree vigorously naturally. :)
<housetier> you could upgrade to libpq3
<mattam> sorry, this is the newest version blablabla... or maybe it's not in a standard package ?
<mattam> Demitar: i don't disagree actually.
<housetier> unstable has libpq3, stable libpq1
<mattam> ok
wats`tralali has joined #ocaml
rox has quit [Connection timed out]
wazze has quit [Read error: 110 (Connection timed out)]
rox has joined #ocaml
TheDracle has quit [Read error: 104 (Connection reset by peer)]
Smerdyakov has quit [calvino.freenode.net irc.freenode.net]
bernard has quit [calvino.freenode.net irc.freenode.net]
TheDracle has joined #ocaml
bernard has joined #ocaml
Smerdyakov has joined #ocaml
The-Fixer has quit ["Goodbye"]
Demitar has quit [Read error: 110 (Connection timed out)]
shawn_ has joined #ocaml
shawn has quit [calvino.freenode.net irc.freenode.net]
Hadaka has quit [calvino.freenode.net irc.freenode.net]
farizeo has joined #ocaml
Hadaka has joined #ocaml
Defcon7 has joined #ocaml
The-Fixer has joined #ocaml
Nutssh has joined #ocaml
Defcon7 has quit [Read error: 54 (Connection reset by peer)]
buggs^z has joined #ocaml
Nutssh has quit ["Client exiting"]
Defcon7 has joined #ocaml
buggs has quit [Connection timed out]
Defcon7 has quit ["changing servers"]
Defcon7 has joined #ocaml
The-Fixer has quit ["Goodbye"]
wats`tralali has quit ["Learning about how the end letters on French words are just becoming more and more silent, I conclude that one day the French]
housetier has quit [Read error: 110 (Connection timed out)]
Swynndla has joined #ocaml
__DL__ has joined #ocaml
__DL__ has quit ["Bye Bye"]
shawn has joined #ocaml
shawn_ has quit [Connection timed out]
Swynndla has quit ["Leaving"]
hf has joined #ocaml
<pattern> let compcoll col ll mm =
<pattern> let l = List.nth ll col in
<pattern> let m = List.nth mm col in
<pattern> compare l m
<pattern> let sortll col ll mm =
<pattern> List.sort ( compcoll col ) ll mm
<pattern> ocaml complains List.sort is used with too many arguments... why?
<mellum> pattern: because it is used with too many arguments
<pattern> but doesn't it take three arguments, like i have?
<mellum> Would it complain then?
<pattern> ( compcoll ll ) is one argument, the comparison function
<pattern> ll is the 2nd arg, and mm is the 3rd, no?
<mellum> Correct.
<pattern> i mean ( compcoll col ) is one argument, the comparison function
<pattern> oh
<pattern> wait
<pattern> my mistake
<Banana> List.sort take 2 arguments pattern.
<pattern> i mistook List.sort's value for the thrid argument
<Banana> he he.
<pattern> i got too wrapped up in my two list thing, for some reason
<pattern> why the hell do i have two lists in any of these functions???
<pattern> i am really daft
<pattern> oh, that's why... the comparison function does compare lists of lists
<pattern> but the sort function should only sort a list of lists of lists
<pattern> ok... now i'm back on track and in sane mode again
<pattern> thank you
<pattern> doing complex things with lists can get really hairy... i know at some point i'm going to wind up with lists of lists of lists of lists of lists of lists
musasabi has joined #ocaml
<musasabi> What does it mean that "ocaml has an orthogonal type system"?
<Banana> that means that it is independant from the language dynamic semantic.
<musasabi> hum?
<mellum> I suspect it's rather that you can assemble types arbitrarily, for example in 'a list 'a can be really any type and not just those derived from Object or something
<Banana> that means you can define the dynamic semantic of the language without reffering to the typesystem.
<Banana> mellum: non.
<Banana> Orthogonal semantic has a precise meaning
<Banana> Orthogonal type system I mean.
<Banana> not semantic.
<mellum> heh. "These terms are not very common"
<musasabi> Banana: thanks, the link looks very good.
blueshoe has joined #ocaml
<pattern> # let bar x = x ;;
<pattern> val bar : 'a -> 'a = <fun>
<pattern> # let baz y = y ;;
<pattern> val baz : 'a -> 'a = <fun>
<pattern> # compare bar baz ;;
<pattern> Exception: Invalid_argument "equal: functional value".
<pattern> doesn't a having a compare function that can cause a runtime exception break ocaml's static typing guarantees?
<Banana> no.
<pattern> why not?
<Banana> because you are not supposed to compare functionnal values.
<Banana> it's the specification of compare.
<Maddas> pattern: Do you know what an exception is?
<pattern> but you might not know they're functional values until runtime... the whole point of a static type system is to prevent those kinds of errors at compile time
<Maddas> compare is magic, isn't it?
<Maddas> pattern: It's not a typing problem. compare deliberately throws the error
<Banana> the type system is to weak to express something like "compare : 'a -> 'a -> int where 'a is a not a ->"
<Banana> pattern: it could return a value.
<Banana> but how do you compare functions ?
<pattern> maddas, i understand it's deliberate... but deliberate or not, the point is that having such a function means that ocaml can't completely guarantee type safety at compile time
<Maddas> pattern: you are wrong.
<Banana> ?
<Banana> why not.
<Maddas> pattern: Type safety is not violated in any way.
<Maddas> How would it be violated?
<pattern> banana, i understand the compiler can't compare function... but that's beside the point
<Maddas> There's nothing wrong with throwing exceptions.
<Maddas> raising exceptions, even.
<Banana> pattern: it's a problem of value not of type... like List.hd on the empty list.
<Maddas> Or an out-of-bounds error
<pattern> maddas, type safety is violated because with compare you are allowed to use types that are wrong for it, and you won't know until run time
<Banana> pattern: they are not wrong.
<Maddas> pattern: you are allowed to use any type with compare!
<pattern> maddas, evidentally not
<Maddas> pattern: whether compare raises an exception or not has nothing to do with this.
<Maddas> pattern: How not?
<Banana> and besides that your program is not in an unpredictable state.
<pattern> maddas, because compare can't compare functions
<Maddas> pattern: ...so?
<Banana> pattern: like divide can't divide by 0.
<Maddas> Type safety doesn't mean that every function works for every allowed (by the type system) argument
<pattern> maddas, so if compare can't compare functions it shouldn't be accepting functions as arguments
<Banana> pattern: yes but the type system is not rich enough to express this.
<Maddas> pattern: How do you implement that as a type signature?
<Banana> that what i was saying.
<teratorn> right, it's either polymorphic or one type.
<Maddas> Exactly
<teratorn> Maddas: I think the point is that SML, for example, doesn't have this problem (or so I've heard).
<pattern> banana, but i don't see how this is a value problem... compare can't compare anything of type function, not just specific values of function types
<Maddas> pattern: Do you think the type safety is violated because you can call List.hd on an empty list?
<teratorn> Maddas: I'm just repeating things I've read, so maybey that's totally wrong.
<Maddas> teratorn: possible -- I never used SML
<Banana> pattern: like sqrt doesn't make sense on negative integers...
<pattern> maddas, no, because an empty list is still a list
<Maddas> pattern: Exactly
<Maddas> pattern: And compare takes 'a and 'a
<pattern> maddas, but i don't see how that applies to compare and function arguments
<pattern> maddas, but it shouldn't
<Maddas> pattern: uh
<Maddas> pattern: So implement it to do otherwise!
<Banana> pattern: I agree that compare is a bit of a hack but it is either this or you only have monomorphic comparison.
<Maddas> Whether it should or not is an entirely different question than whether it does :-)
<teratorn> pattern: perhaps if you could explain how SML does this (because I'm curious) :)
<Banana> int_inf float_inf and to define inf for each type you define :|
<Maddas> pattern: If you write a function that takes 'a and throws an error no matter what, you didn't violate type safety either.
<pattern> maddas, ok... let me rephrase that to: since compare does accept types it can't operate on then it breaks type safety
<Maddas> no, it does not, pattern.
<teratorn> Maddas: well you didn't violate "the O'Caml type-system", for sure.
<Maddas> teratorn: Did I say something wrong? :)
<teratorn> Maddas: whether that is equal to absolute type-safety is another question thought :)
<pattern> ocaml's type system just seems kind of loose on this point
<Maddas> pattern: I don't see the problem, sorry.
<pattern> anyway, this really isn't my argument... i heard this from someone else, and wanted to know what people thought
<teratorn> Maddas: I'm just making a semantic point regarding your speech, I don't know if what you said is right or wrong ;)
<Maddas> Yes, you can't have a type "'a except int", if you mean that.
<Banana> pattern: le me explain clearly. you agree that divide is not a total function (that is, there are values from it's definition domain (int*int) that are not accepted))
<Maddas> pattern: I still don't see how it violates type safety. The point is that it takes 'a, and how would you violate that? :)
<pattern> maddas, i don't really have a big problem with it... but i do see how some people who wanted absolute type safety would
<Maddas> pattern: I don't see this not being type safe at all.
<pattern> banana, yes
<Banana> all value (int*0) are not defined.
<Banana> for compare it the same thing.
<Banana> all values 'b -> 'c are not defined.
<Maddas> Whether compare is implemented for functions has nothing to do with its type signature, or am I wrong?
<pattern> maddas, i guess the reason i think it violates it is because you won't know until run time that it can't really use an argument of a certain type
<Banana> pattern: you could have this kind of type safety with dependant types and thing like this. But this would make type inference a non decidable problem.
<pattern> maddas, so it **claims** to accept any kind of value, but really doesn't
<Banana> which would suck.
<Maddas> Type safety doesn't mean that you always know what is in a variable
<Maddas> pattern: It does.
<Maddas> It accepts anything, it just raises an exception later on if it's not happy with what it got.
<Maddas> Just like writing a function that accepts anything and always raises an exception doesn't break type safety :)
<pattern> banana, but the value is of a certain type (namely a function or an int or a float, say)... i could see your argument with exceptional values within one certain type, but this is really an exceptional type, if i can coin a term
<Maddas> pattern: exception Foo;; let a = fun x -> raise Foo; 0;;
<Maddas> pattern: would you say that that breaks type safety?
<pattern> hmm
<pattern> i guess not
<Maddas> pattern: you never get any type violation from what compare does.
<Banana> pattern: you misunderstand what strong typing means. It doesnt means the function will actualy be able to compute something wiht values of the good type, it means the programm will not be in an impredictable state if you pass value of the right type.
<Maddas> Yeah
<Maddas> If you have 'a, you can't know what is inside it without looking at where it came from.
<Maddas> (And that is completely irrelevant to this discussion, I just noticed)
<teratorn> it won't be in an undefined state /because it throws exceptions/
<pattern> at run time
<Maddas> Exactly
<teratorn> and your program terminates if you aren't prepared for it
<Maddas> pattern: How could it throw an exception at compile-time?
<pattern> but the whole point of the type system is to catch incompatible types at compile time, no?
<Maddas> Yes
<Maddas> The types are never incompatible
<Maddas> compare just _decides_ to throw an exception
<teratorn> they aren't no, it's just a practical implemntation point
<pattern> incompatible with the what the function expects for arguments
<Maddas> It might also return 0 if it wanted to, that would just be stupid.
<Maddas> no, it's not incompatible
<Maddas> pattern: Do you know that compare takes 'a?
<pattern> yes
<Maddas> So how is it incompatible?
<Maddas> do you say that the example I gave before (always raising an error) breaks the type system?
<pattern> because it can't compare functions... but i am convinced by your earlier arguments anyway
<Maddas> Whether it raises an exception or not is only implementation-specific, as teratorn said.
<Maddas> It "can't"? It doesn't
<Maddas> Since there is no sane way to figure out how :P
<pattern> maddas, yes, your exception example was confincing
<pattern> convincing
<Maddas> It would break the type system if it would return a string, for example
<Maddas> or if the signature was 'int -> int -> int' and you could pass it a function
<pattern> as was banana's explanation of type systems as guaranteeing that your program won't be in an impredictable state
<Maddas> Yeah
<Maddas> And to guarantee that a variable will *always* contain something of the type it is
<pattern> you mean if it would return a string when its signature said it would return a bool?
<Maddas> if the compiler wouldn't catch that, yes, that would be a violation of tyep safety
<Maddas> (unless I'm talking bogus...)
<pattern> right
<pattern> that's what i thought you meant
<Maddas> type, even.
musasabi has left #ocaml []
<Banana> pattern: in fact there is a 'simple' (hum took one month to fully proove it ~_~) theorem named "subject reduction" that says : IF the evaluation of a well typed term terminate THEN the result is still well typed. No more no less. And that is what is ensured by ocaml. the point is that compare does'nt return in case of functional argument so...
<Maddas> That is why you have exceptions -- to escape without returning a bogus value
<Maddas> heh :)
<Banana> :)
<pattern> i see
<Maddas> You could always just return some value of the type it wants -- it just would make programming harder
<Maddas> Or if you figure out a clever and useful way to compare those functions, feel free to add support for it :-)
<pattern> still, it seems like compare really should not accept functions
<Maddas> Whether it should or not is an entirely different question
<Banana> pattern: well let's say it would be stronger if it couldn't accept function.
<Maddas> You can't tell it to accept everything else, so either you accept everything or just one type.
<pattern> but i understand how to implement it otherwise would require a seperate compare for each type
<Maddas> There you go :)
<Banana> (but that cannot be made with type inference as it is).
Nutssh has joined #ocaml
<Maddas> Just like List.hd "shouldn't" accept an empty list -- but you don't always know what's in the list at compile-time
<pattern> is it possible to have a language where you can join types?
<Maddas> Since an empty list is of the same type as a not empty list :)
<Banana> pattern: yes but without type inference.
<Maddas> Yeah, that's the drawback
<pattern> i see
<Banana> there is a need for the programmer to anotate the program.
<Banana> pattern: eg : type systems with dependant types.
<Banana> they are very nice.
<Maddas> That's the problem with overloading, for example
<pattern> "dependant types"?
<Banana> pattern: a dependant type is a type with "a value inside"
<Banana> eg : the type of list of lenght 3.
<pattern> the value being another type?
<Maddas> if + accepts exactly int, float, int32 and int64, you cannot infer the type fo this: let add a b = a + b
<Maddas> of, even.
<pattern> yeah
<Banana> pattern: then you can at compile time*** see that you are calling List.nth 4 on a list of lenght 3.
<pattern> cool
<Banana> the problem with those typesystems is that they are very very strict and it's very difficult to write something big with it.
<pattern> well, wouldn't it also allow more general types?
<Banana> (And I have to write a compiler with it ~_~...).
<pattern> heh
<Banana> pattern: what do you mean by more general type ?
<pattern> i mean just a plain list
<Banana> a list of anything ?
<pattern> without the "values inside"
<pattern> yeah
<Banana> like [ "a"; 1 ] ?
<Banana> i'm not sure.
<pattern> well, just [ 1;2 ]
<Banana> ?
<Banana> [1;2] is a simple int list.
<Maddas> a list with anything inside? 'a list
<Banana> in those typesystems, types are terms so you can even compute on types.
<Maddas> oh, sorry, you were not talking of O'Caml :)
<Maddas> Banana: sounds fun
<Banana> or you can add logical properties to types :
<Nutssh> I don't know. As a rule, mose well-behaved C code tries to avoid what in ocaml would be typing bugs.
<Banana> the type of trees wich are balanced binary trees.
<pattern> i mean you had said type systems with dependant types are very very strict and it's very difficult to write something big with them... so my question is whether using the dependant type systems like regular type systems most of the time, but maybe with a few of these types with "values inside" might give you an easier time of developing your application with them
<Maddas> Nutssh: It *sounds* fun to me.
<Maddas> I doubt it is, since things are rarely as good as they sound :-)
<Maddas> uhm, or maybe you weren't talking to me anyway
<Nutssh> If you make the type system much more complicated, then type inferencnce breaks --- it becomes exponenitial or even uncomputable.
<Maddas> Turing complete type systems :-)
<Nutssh> C++ templates. Do we really want to go there? :)
<Maddas> Who needs values anyway!
<Maddas> Nutssh: haha
<Banana> pattern: the problem is that the system I am using (Coq Prof assistant) as other features... such as you have to guaranty (i mean give a formal proof) that your program terminates.
<pattern> ahh
<pattern> sounds like much unfunness
<Banana> so it's realy pain in the ass to write something big.
<Nutssh> Termination is overrated. :)
<pattern> so why do you want to work with these unfun tools?
<Banana> but the good part is that if you have a proof of something (let's say the proof of the quicksort algorithm on int list) then it can extract the ocaml code of the programm proved.
<pattern> cool
<Banana> (and the extracted prog is pretty much like the one you would have written).
<Banana> but it's still experimental...
<Banana> I mean not widely used.
<pattern> will it write an optimal program for you? :)
<Banana> pattern: if you gave the optimal proof.
<pattern> heh
<Maddas> Banana: I want to tell it "Quicksort!" and it should have voice recognition and figure out the optimal solution for my problem! :P
<pattern> yeah!
<Banana> Maddas: that's on the Todo List.
<pattern> how long do we have to wait?
<Maddas> Banana: You'll make many people job-less if you finish :)
<Banana> right after : "Make an IA that can make coffee when we want it".
<Banana> "and bring donnuts".
<Banana> (I mean croissants, not donnuts.)
<Banana> Maddas: well most of these problem are not decidable in general... (one can't even decide wheter a program terminate or not so...)
<Maddas> Just make it work :>
<Banana> he he.
<Banana> sounds like an industrial to me :)
<Maddas> Just throw more money at it and it'll become decidable soon enough.
<Banana> "But mathematicaly that can't be done ..." " Never mind, we already sold it"
<Maddas> I want it by next week!
<Maddas> heh
<Maddas> "You tell that to the customers."
<Banana> ha ha.
<Banana> well lunch time.
<Banana> and lectures this afternoon.
<Banana> see you.
Banana is now known as Banana[AFK]
<Maddas> Bye
<pattern> see you
<pattern> thank you both for explaining that compare thing for me
srv has quit ["leaving"]
srv has joined #ocaml
yangsx has joined #ocaml
<yangsx> I cannot received mails from caml-list for a few days. anybody know why?
yangsx has left #ocaml []
yangsx has joined #ocaml
<pattern> yangsx, i haven't seen the mailing list archives update either... i think there must be a problem with the list
<pattern> it must have been written in an inferior language ;)
<yangsx> pattern: thanks. then that's not a problem with my mail service provider.
<pattern> yeah, here's this month's archive - http://caml.inria.fr/archives/200402/threads.html
<pattern> clicking on chronological order shows me that the last message is from the 11th
<yangsx> yes. I saw that too, but I think I received messages as late as Tuesday.
yangsx has quit ["离开"]
<pattern> i'm having a hard time thinking of a recursive way to achieve something...
<pattern> i have a sorted list of integers... say, [1;1;2;3;3]
<pattern> i want to transform that in to a list of lists, like so: [ [1;1] ; [2] ; [3;3] ]
<pattern> the basic idea is to go through the list from head to tail, and create a new list when the element you're evaluating doesn't match the last element seen
<ejt> take the head, build a predicate for = head, use partition, recurse
* pattern looks up partition
whiskas has joined #ocaml
<pattern> ejt, but how can i tell the predicate what the last value was?
<pattern> partition only looks at one element at a time, right?
whiskas has quit ["Pa / Bye."]
karryall has joined #ocaml
whiskas has joined #ocaml
<mellum> pattern: I'd just write a loop
<pattern> why are you trying to make this easy for me??
<pattern> ;)
<Maddas> I'm sure this can be done with a List.fold(_left|_right)
<Maddas> I just can't quite figure it out yet :)
<pattern> hmm... i didn't think of using those, but makes perfect sense
<pattern> in my own abortive attempts i was passing my function the last value seen so far, and returning a list containing all of the same elements as the first element of a tuple and the rest of the different element as the second element
<pattern> but that wasn't working too well
<pattern> foldl/foldr would definitely be more natural
housetier has joined #ocaml
<slashvar> Hi
<Maddas> ah, that's why it didn't work
<pattern> if you figure it out don't tell me yet
<Maddas> my brain seems to refuse to work
<pattern> i want to try foldl/foldr myself first
<Maddas> i'm very close to it, but the returning a list of lists part doesn't work out :-)
<pattern> i think you have to use an exception in the fold
<Maddas> I got that working
<pattern> and return a tuple of the list of elements so far and the rest of the list
<pattern> and then rerun the fold on the rest of the list
<Maddas> you lost me there :P
<pattern> ok...
<Maddas> don't worry though, just tell me if you got it!
<pattern> there's more than one call of fold
<pattern> the first to generate [1;1] and then antother for [2] and a third for [3;3], etc..
<Maddas> ah, I see
<Maddas> ok :-)
<Maddas> anyway, I should be doing other things ;-)
<pattern> well, i'm on the right track, i think
<pattern> thanks, maddas
<pattern> hmm... now i don't think that'll work... because foldl/r don't give you the rest of the list if you use an exception to jump out
<pattern> might have to forget generating an exception and pass a tuple of the last value along with a flag indicating whether it's reached a different value, and then collect the rest of the list
<Maddas> :/
whiskas has quit ["Pa / Bye."]
blueshoe has quit [Read error: 104 (Connection reset by peer)]
rox has quit [Read error: 60 (Operation timed out)]
rox has joined #ocaml
<pattern> finally
<pattern> it's super ugly, but it works
<mellum> how about
<mellum> let f l =
<mellum> let rec loop accu x xs = function
<mellum> [] -> List.rev accu
<mellum> | y :: r when y = x -> loop accu x (x :: xs) r
<mellum> | y :: r -> loop (xs :: accu) y [y] r
<mellum> in
<mellum> if l = [] then [] else loop [] (List.hd l) [] l;;
<pattern> that doesn't work
<pattern> # f [1;1;2;3;3;4;5;5;5];;
<pattern> - : int list list = [[1; 1]; [2]; [3; 3]; [4]]
<mellum> Whoops. But something similar should :)
<pattern> yeah, i can see you're way ahead of me
<pattern> i don't even understand it yet...
<mellum> and that with only one cup of coffee!
<pattern> :)
hammerslane has joined #ocaml
<ejt> let rec split = function
<ejt> | [] -> []
<ejt> | xs ->
<ejt> let (h, t) = List.partition ((=) (List.hd xs)) xs in
<ejt> h :: (split t);;
<ejt> pattern: you can make this tail recursive by just adding an accumulator
Vjaz has quit [Read error: 110 (Connection timed out)]
<karryall> blerk, List.hd
<ejt> ?
<karryall> use a pattern instead
<ejt> of course
<karryall> | x :: _ as xs -> let (h, t) = List.partition ((=) x) xs in
<ejt> let rec split = function
<ejt> | [] -> []
<ejt> | (x :: xs) as lst ->
<ejt> let (h, t) = List.partition ((=) x) lst in
<ejt> h :: (split t);;
<ejt> y, no need for xs
<pattern> cool
<pattern> that's really elegant
<ejt> functional programming is
<pattern> only when done by good programmers :)
<ejt> you'll get the hang of it v. quickly
<pattern> well, i am making progress in understanding it... and i can solve some simple problems... but intermediate level problems and elegant design still eludes me
<pattern> need more practice
<pattern> and, actually, this particular problem is just a prequel to the real one
<pattern> in which i'm going to do the same thing but for lists of lists
water has joined #ocaml
<ejt> just at the top level ? or for the sub lists as well ?
water has left #ocaml []
<pattern> in the sub levels
<pattern> kind of
<pattern> i think i'm too exhausted to even describe it right
<ejt> not sure what you mean, but I'm sure you're nearly there already
<pattern> yeah
<pattern> you've gotten me most of the way
<pattern> it would have been a mess to do it with my own code... yours is so much more elegant i think i'll have no problem
<pattern> ok, time to sleep...
<pattern> thanks again everyone!
<hammerslane> n/p
Nutssh has quit ["Client exiting"]
tomasso has quit [Read error: 54 (Connection reset by peer)]
The-Fixer has joined #ocaml
buggs^z is now known as buggs
gl has quit [Read error: 60 (Operation timed out)]
gl has joined #ocaml
<gl> 're
hammerslane has quit ["ChatZilla 0.9.59p [Mozilla rv:1.5/20031007]"]
Nutssh has joined #ocaml
whiskas has joined #ocaml
The-Fixer has quit ["Goodbye"]
The-Fixer has joined #ocaml
Demitar has joined #ocaml
wazze has joined #ocaml
Axioplase has joined #ocaml
<Axioplase> Hi!
<gl> hi
<karryall> alors, le calcul de exp ?
<Axioplase> gl there was an answer to my problem with the "until" function. but i didn t have time to note it down :/ All i can say is that it was truly monstruous :)
<karryall> mais non
<Axioplase> mais si :) le gars utlisait des n-uplets de n-uplets de n-uplets !
<karryall> t'abuses, je t'ai explique comment il fallait faire
<karryall> pas besoin, un tri-plet suffit
<gl> (ca devait etre code avec les pieds)
<karryall> ouais
<Axioplase> m empeche que la version proposée (par un eleve, le prof savaitpas faire) etait pas belle du tout...
<karryall> je dois encore avoir la solution qqpart sur mon disque
<gl> l'eleve en question a du zapper le cote fonctionnel du langage :)
<Axioplase> de toute facon j ai d autres exos maintenant :)
<gl> URL ?
<ejt> is there a shell library ? eg. that handles redirection, fork, exec etc ?
<gl> Unix don't do it ?
<gl> *doesn't
<ejt> Unix is fine, I just thought I'd heard of a higher level lib
<karryall> ejt: there's Shell, written by G.Stolpmann
<ejt> thx
<karryall> and there's Cash
<Axioplase> gl une url de mes exos? nan... un poly...
<gl> dommage, je voulais voir le genre d'exos que vous faites
<karryall> Axioplase: j'ai retrouve, tu veux ma solution ?
<Axioplase> karryall balance toujours.
<karryall> let rec until f p x =
<karryall> if p x
<karryall> then x
<karryall> else until f p (f x)
<karryall> rien de nouveau
<karryall> let expo epsilon x =
<karryall> let init = (1, 1., 1.) in
<karryall> let f (n, term, sum) =
<karryall> let next_term = term *. x /. (float n) in
<karryall> (n+1, next_term, sum +. next_term) in
<karryall> let p (_, term, _) = term < epsilon in
<karryall> let (_, _, sum) = until f p init in
<karryall> sum
<Axioplase> karryall j avais pas encore vu "(_,_,foo)"
<karryall> le "_" veux juste dire "ignorer ce morceau"
<gl> ca change rien
<karryall> tu peux mettre un nom, c'est pas important
<Axioplase> ca change que j avais pas le droit/besoin de l utiliser. et je vois pas de factorielle dans le prog.. pour calculer la suite qui tend vers e(x)
<gl> Axioplase pas grave, du remplace le next_term de karryall par une version avec factorielle
whiskas has quit ["Pa / Bye."]
<karryall> pas besoin de factorielle
<gl> ah non meme pas
<gl> j'ai rien dit
<karryall> term vaut x^n/n!
<karryall> donc le suivant vaut term * x / (n+1)
<Axioplase> tu la calcules comment ton expo la ? (et le prof voulait un(x)-un+1(x) < epsilon pour la précision)
<Axioplase> ha ouais...
<karryall> la c'est un epsilon relatif
<karryall> (exp(x) - un(x)) / exp(x) < epsilon
<Axioplase> bref. la maintenant, je fais un prog qui genere la "pyramide" suivante:
<Axioplase> 1
<Axioplase> 11
<Axioplase> 21
<Axioplase> 1211
<Axioplase> 111221 etc...
<gl> on voit
<gl> les fourmis, quoi
<Axioplase> ouais :)
<Axioplase> donc je vais y relflechir un peu avant de vous importuner encore.
<gl> tu stockes tout dans une liste d'entiers ?
<Axioplase> je sais pas, j ai pas encore commencé. (dans une liste de liste d entier)
Nutssh has quit ["Client exiting"]
<Axioplase> allons bon... mon ocaml il connait pas tl..
<Axioplase> c est *normal* ? (dans le cours, il parait que c est une fonction de base...)
<karryall> List.tl ?
<Axioplase> ha ptet. je sais pas.
<Axioplase> ha ouais, on dirait bien.
<karryall> c'est qui ton prof au fait ?
<Axioplase> heu...
<Axioplase> Mathieu Jaume. tres sympa. sauf quand il coorige pas quand personne ne veut aller au tableau..(et c est pas faute d avoir essayé de faire les exos..)
<Axioplase> d un autre coté, il dit ne faire des progs comme nos exos qu une fois par an, quand il fait son cours =)
<karryall> arf il fait du FOC
<karryall> j'ai un pote qui a fait sa these dans son labo
<Axioplase> FOC ?
<Axioplase> y a un mauvais jeu de mot ? :/
<karryall> non :)
<Axioplase> c est quoi le foc alors ?
<Axioplase> que je puisse faire du chantage et grapiller des points :)
<karryall> c'est un projet de recherche
<karryall> un environnement de calcul formel certifié
<gl> utf8 !!
<Axioplase> qq1 utilise vi(m) ici sinon?
<Axioplase> nan, c est bon.
<karryall> gl: quoi utf8 ?
<Axioplase> karryall t es en utf8. et il parait que c est pas bien.
<karryall> hum, j'ai pas fait vraiment expres
<karryall> (comment ca se desactive ce truc ?)
<Axioplase> xchat ?
<karryall> ERC
<Axioplase> essaye /charset iso-8859-15
<karryall> c'est tres bien l'utf-8
<karryall> bon enfin
<karryall> A+
karryall has quit ["maison"]
Nutssh has joined #ocaml
<Axioplase> Argh!
<Axioplase> i have calc_prefix wich returns the number of times that an int is seen at the beginning of the list
<Axioplase> clean n l which removes then n first ints of my list.
<Axioplase> and my generate_list that loops infinitely :/
<Axioplase> let rec genere_liste l =
<Axioplase> genere_liste [1;1;1;2];;
<Axioplase> hu
<Axioplase> let rec genere_liste l =
<Axioplase> (calc_prefix l)::(List.hd l)::(genere_liste (clean (calc_prefix l) l));;
<Axioplase> there...
<Smerdyakov> What if the int isn't in the list?
<Smerdyakov> I mean, clearly this loops infinitely, since there is no base case!!
<Axioplase> then i don't know what to do nor when :/
<gl> hum
<gl> i took 5 min to do it, but take a look at: http://vect.nerim.net/pyramid.m
<gl> .ml
<Axioplase> shouldargh :)
<Axioplase> s/should//
<Smerdyakov> You don't know how to write a recursive function, you mean?
<gl> It's really ugly, but ...
<Axioplase> i lacked an "if [] then [] else"
<gl> # pyramid 1 6;;
<gl> - : int list = [1; 3; 1; 1; 2; 2; 2; 1]
<Banana[AFK]> gl: file not found.
<gl> is that what you want ?
<Banana[AFK]> file not found.
<Axioplase> not yet. lemme have 2 minutes left
<Banana[AFK]> i can read. :|
<gl> uh ? :)
<gl> don't blame me, i'm ill :)
<Nutssh> Hi.
<gl> HI Nutssh
<Smerdyakov> Ill will in the hill.
<Banana[AFK]> yo got it bill.
<Banana[AFK]> you.
<Banana[AFK]> arf
Banana[AFK] is now known as Banana
<Nutssh> Does anyone know if there are some documents describing the design of the ocaml native code compiler?
<gl> maybe the CIA
<gl> *knows
<gl> ...
<Axioplase> s/knows/know
<gl> :(
<Banana> s/know/knows ?
<Axioplase> "Does anyone know". there is no "s" since there is a "does".
<Axioplase> (and it s a regexp for "swap knows with know" according to what gl wrote.
<Axioplase> gl and your pyramide is wrong :)
<Riastradh> 'Knows anyone if there...?' and 'Does anyone know if there...?' are both correct, but not 'Does anyone knows if there...?'
<gl> axioplase show me where it's wrong (i mean an example)
<Banana> Axioplase: i know what a regexp is....
<Banana> i don't see why maybe the CIA know is correct. The does is in the question isn't it ?
<Axioplase> gl forget it, i read the wrong line on my output :)
<Axioplase> gl forget it, i read the wrong line on my output :)
<Axioplase> gl forget it, i read the wrong line on my output :)
<Axioplase> gl forget it, i read the wrong line on my output :)
<Axioplase> argh.
<Axioplase> gl forget it, i read the wrong line on my output :)
<Axioplase> argh!
<Smerdyakov> LOOOOOOOOOL
<Banana> ?
<gl> :)
<Axioplase> i can't write anymore :/
<Banana> gl: you should REALLY forget this. :)
<Axioplase> who fsck :/
<gl> he's not insistent enough
<Axioplase> i had pressed pageup and couldn t see my text :)
<Banana> ^_^
Axioplase has left #ocaml []
Axioplase has joined #ocaml
Nutssh has quit ["Client exiting"]
<Riastradh> Banana, whether or not 'the CIA know' is correct depends on whether or not you consider corporate & governmental entities in the singular or plural, both of which are accepted in differing parts of the world.
<Banana> ok.
<Banana> well in france we say "The CIA knows" :D
<Banana> time to eat something.
<Banana> bbl.
drWorm has joined #ocaml
<drWorm> is "mutually recursive" types possible? as in 'type a = Foo of b' and 'type b = Bar of a'?
<whee> drWorm: type a = Foo of b and b = Bar of a
<drWorm> hm, i'm sure i tried that...
<drWorm> yes, syntax error on the second "type" keyword
<drWorm> oh, never mind, i'm stupid :)
<whee> there is no second type keyword
<whee> hheh
<drWorm> works, thanks :)
<drWorm> although it screws up indentation in emacs
<drWorm> nah, not if i line it up correctly
yinnte has joined #ocaml
yinnte has quit [Client Quit]
Nutssh has joined #ocaml
hf has quit [Nick collision from services.]
hf has joined #ocaml
hf has quit [Nick collision from services.]
Nutssh has quit ["Client exiting"]
hf_ has joined #ocaml
<Axioplase> \o/ I coded RLE compression in Ocaml \o/
<Smerdyakov> Axioplase \in Kings of the world
<Axioplase> :)
<Axioplase> I should have taken Java at the university.. i would have packed that prog in 15 minutes max... instead of 5 hours...
<Smerdyakov> And your brain would have remained a lump of simpering stew.
<Axioplase> actually, i would have coded it in C, then converted in Java on the flight. (is this the right way to say, "on the flight" ? )"
<Smerdyakov> What do you mean by "on the flight"?
<Smerdyakov> I would take it to mean "while on an airplane trip."
<mattam> i think you mean 'on the fly'.
<Axioplase> cat source.C | dont_use_brain > source.java
<Axioplase> mattam i also think so :)
<Smerdyakov> "On the fly" connotes converting parts as you need them, while it sounds like you would convert it all in one chunk.
<Smerdyakov> Axioplase, you might find it hard to believe now, but people who know ML well tend to be able to code programs in it much faster than they can in C or Java.
<Axioplase> Smerdyakov well.. i ve coded in C for years, and Caml for days... so... i trust you, but i m not used to coding in ml yet...
tomasso has joined #ocaml
<Axioplase> type foo ={bar: char list};; How can i fetch the first element of this list ?
<Smerdyakov> It might not have a first element..
<Axioplase> well... if i do e.bar, it returns me a list, doesn't it ?
<Smerdyakov> Yes.
<Smerdyakov> But not every list has a first element.
<Axioplase> i see...
<Banana> Axioplase: you can : match e.bar with | [] -> ... | x::xs -> ...
tomasso has quit ["Leaving"]
<Axioplase> Banana yeah. Ifigured out i just needed to test that [].
Nutssh has joined #ocaml
<Axioplase> argh...
<Axioplase> I cant have my function info list -> char list list corrected in info list-> char list !! grr
<Smerdyakov> What?
<Riastradh> Huh?
<Axioplase> i have a decode function that takes an "info list" and returns a char list list instead of a char list.
<Axioplase> and i cant manage to correct it.
<Axioplase> type info = {cha:char list; {number:int; obj:char}}
<Axioplase> here is the guilty code:
<Axioplase> let rec decodage l= match l with
<Axioplase> []->[] | e::r-> if e.ob.number=0 then e.cha::decodage (List.tl l))
<Axioplase> else (repeat e.ob.obj e.ob.number)::decodage(List.tl l);;
<Nutssh> e.cha is a list, being added on with e.cha:: to another list. Perhaps you mean that to be append?
<Axioplase> and repeat is "'a -> int -> 'a list" that repeats n times the element give,
<Axioplase> well... What i get at the output is like [['a'];['a'];['b';'b';'b'];['c'] ]
<Axioplase> whereas i want ['a';'a';'b';'b';'b';'c']
<Nutssh> If you want an idea whet the problem is, explicitly declare the types of the inputs and out of decodage.
<Nutssh> let rec decodage (l:char list) : char list = ...
<Axioplase> "This expression has type char list list but is here used with type char list"
<Axioplase> same as without the declaration
<Nutssh> Or whatever you want. Look at the clause it is complaining apart. Thats the mistake.
<Smerdyakov> Axioplase, what is the type of repeat e.ob.obj e.ob.number?
<Axioplase> Smerdyakov e.ob.obj is a char, and e.ob.number is an integer
<Smerdyakov> Axioplase, and what is the type of the whole expression (repeat e.ob.obj e.ob.number)?
<Axioplase> should be char list indeed...
<Smerdyakov> OK, and so what is the result type of using :: when the first argument is a char list?
<Axioplase> I found out.
<Axioplase> it was @ instead of ::
<Axioplase> thank you... you got me on it.
silentB has joined #ocaml
silentB has left #ocaml []
Kinners has joined #ocaml
karryall has joined #ocaml
Nate1975 has joined #ocaml
Nutssh has quit ["Client exiting"]
Nate1975 has quit ["using sirc version 2.211+KSIRC/1.2.4"]
Nate1975 has joined #ocaml
shawn has quit [Read error: 104 (Connection reset by peer)]
Demitar has quit [Read error: 110 (Connection timed out)]
Kinners has left #ocaml []
shawn has joined #ocaml