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
Demitar has quit [Read error: 60 (Operation timed out)]
Tamagucci has joined #ocaml
Defcon7 has quit [Remote closed the connection]
Nutssh has quit ["Client exiting"]
Defcon7 has joined #ocaml
buggs is now known as buggs^z
cjohnson has left #ocaml []
Tamagucci has left #ocaml []
Tamagucci has joined #ocaml
Tamagucci has left #ocaml []
housetier has joined #ocaml
det has quit [Remote closed the connection]
Nutssh has joined #ocaml
<blueshoe> ml97 defines a class of types called "equality types", which are types that allow equality to be tested for among the values of that type... does ocaml have something equivalent?
<blueshoe> for example, in ml97 integers, booleans, characters and strings are among the equality types, but reals aren't
<blueshoe> tuples and lists of equality types are also equality types
<blueshoe> but "nil" (or [] in ocaml) isn't
<blueshoe> neither are functions
<Nutssh> You can't Pervasives.compare and get equality?
<blueshoe> i've never looked in pervasives, but isn't the = operator enough?
<blueshoe> that's what ml97 uses
<Nutssh> That also works. Pervasives.=
<blueshoe> the reason i'm asking is because a function which complains in ml97 works in ocaml
<blueshoe> # let rec rev1 l =
<blueshoe> if l = [] then []
<blueshoe> else rev1( List.tl l)@[List.hd l];;
<Nutssh> I think the ocaml implicit is that all types are equality types -- at least in that they may be compared with '=' or compare. It may return false in all situations, but its comparable.
<ayrnieu> blueshoe - by your description of 'equality types', you want a typeclass.
<blueshoe> if "foo", "bar" and "baz" are functions of type int -> int -> int then passing a list of them to rev1 fails in ml97, because they're not equality types
<blueshoe> but it works in ocaml
<Nutssh> blueshoe: Ok, The problem I think is that [] is not a concrete type, its type is 'alpha list'. You probably want to do a match.
<ayrnieu> blueshoe - indeed, [] without qualification does strange things.
* ayrnieu forgets his example of O'Caml breakage with [] -- the mailing list surely talks about it.
<Nutssh> Declare 'l' to be of some concrete type 'int list' or something and the problem should go away.
<Nutssh> '[]'
<blueshoe> but it's not a problem in ocaml
<blueshoe> ocaml works fine
<blueshoe> it's ml97 that doesn't
<ayrnieu> blueshoe - oh, I misread you.
<blueshoe> so that's why i thought there must be some difference in the definition of equality types
<Nutssh> '[]' has no concrete type. Ocaml allows you to cheat because '=' violates the normal type system.
<blueshoe> "nil" (the [] equivalent in ml97) is not a concrete type either
<blueshoe> i think
<Nutssh> *hmms*
<Nutssh> This works (bringing up what ayrnieu said) What does '_a mean.. TIme to pop open the book.
<Nutssh> # let foo=ref [];;
<Nutssh> val foo : '_a list ref = {contents = []}
<blueshoe> and it's not an equality type in ml97, which is why ml97 fails
<ayrnieu> blueshoe - you want to use pattern matching, anyway.
<ayrnieu> and by 'ml97' do you mean SML?
<blueshoe> ayrnieu, yes, there's pattern matching in the ml97 example as well.. they contrast the breakage of the = vs the success of pattern matching in ml97 with "nil", which is not an equality type
<blueshoe> ayrnieu, yeah
<Nutssh> Equality types are screwey.
<ayrnieu> blueshoe - aside, then: #SML also exists on this server.
<blueshoe> well, it's ocaml i was really asking about
<blueshoe> is [] an equality type in ocaml
<blueshoe> does ocaml even have such a thing as "equality types"?
<blueshoe> or is anything potentially comparable with = ?
<Nutssh> blueshoe: How about reasoning from first principals? If you invoke a function f: 'a foo -> 'a foo -> bool on two non-concrete types, than it *must* be well defined for any such object 'a foo.
<blueshoe> what do you mean by "well defined"?
<Nutssh> blueshoe: You got it. I said so about 10 min ago. Everything is comparable with Pervasives.compare, Pervasives.=, and pervasives.==.
<blueshoe> nutssh, so is = equivalent to Pervasives.= ?
<Nutssh> Yes. the Pervasives module is opened by default so that '=' gets picked up from there.
<blueshoe> i see
<blueshoe> very cool
<Nutssh> Its even redefinable
<Nutssh> # let (=) a b = 12;;
<Nutssh> val ( = ) : 'a -> 'b -> int = <fun>
<Nutssh> # 3=5;;
<Nutssh> - : int = 12
<blueshoe> yeah, i think i've played around with stuff like that long ago... :)
<blueshoe> neat feature
<ayrnieu> blueshoe - yes, I know, hence the 'aside'.
<Nutssh> well defined means that the function is well-defined on the inputs. A function f with the type above may be ill-defined for 'a = outstream or something.
<Riastradh> The type system hacks to get generic equality comparisons in both SML and OCaml are yuckulous.
<blueshoe> nutssh, can you restate your definition in the first sentence without using the word "well-defined"?
<Nutssh> No. Well-defined in this sense refers to well-defined in some metalangauge sense --- something outside of the type system constrains 'a to be, say, not 'iostream.
<blueshoe> nutssh, so are you saying that something that is well-defined accepts as input what it is supposed to?
<ayrnieu> blueshoe - in other words, the domain of Pervasives.= has limitations not described by O'Caml's type system.
<Nutssh> What I'm saying is pretend we have a function f with the signature above, except that something outside of the type system means that 'a cannot, for instance, be iostream.
<blueshoe> ayrnieu, what kind of limitations?
<Nutssh> ayrnieu: Thats not what I'm saying. I'm talking about the function f.
<ayrnieu> nutssh - ah, right.
<blueshoe> nutssh, ahh... so you're saying that the type system may not cover real equivalence? it can only test for type equivalence?
<Smerdyakov> Does anyone know offhand of a Coq standard library function to take in two Z's and return a bool based on if they are equal?
<Nutssh> .. and I am not referring to either ocaml or sml as a concrete language. I'm looking at the hindley milner type system.
<ayrnieu> blueshoe - what I said should hold for the aforementioned function 'f' =)
<Nutssh> No, what I'm saying is we have a problem. A function that appears for all intents in purposes is declared in the type system to have type '' FORALL_'a, 'a foo -> 'a foo -> bool', except that we, not constrained by the typesystem know it should be illdefined on 'a == iostream.
<ayrnieu> let f x = x / 0;;
<Nutssh> Thats not quite a good example, ayrnieu, that function is undefined on a particular value. my f is undefined on a particular type.
<ayrnieu> nutssh - aye. blueshoe's original question seems to contain a better example for your function f -- for the case of SML, at least.
<blueshoe> nutssh, so are you saying that there are exceptions that the equvalency operator may not handle?
<Nutssh> So, there are two fixes to this problem. Either A: We can force f to be defined on all types, and do something cheezy -- outside the type system --- for 'a == iostream.
<Nutssh> Or, we can create a new abstract type variable '_NOT_IOSTREAM_a which stands for all types that are not iostream. We can now define f to have type
<Nutssh> No. I'm describing the design decision that is used.
<blueshoe> right
<blueshoe> which is a decision concerning this exception, right?
<Nutssh> f: '_NOT_IOSTREAM_a -> '_NOT_IOSTREAM_a -> bool And now all will be well with no type system breakage.
<blueshoe> i see
<ayrnieu> Nutssh - from this alternative I'd read SML as following the latter and O'Caml as following the former, regarding Pervasives.=
<blueshoe> so is [] an exceptional case?
<Nutssh> Yes. they decided that equality was too useful, and tHey didn't want a seperate equality function for each and every type. Int.= Float.= Tuple.= ... ... ...
<Nutssh> [] is an open type, As a general rule, those are bad. I'd need to think a bit more to figure out why sml-nj was unhappy with your code.
<blueshoe> but they did choose to use /. vs /
<Nutssh> Actually, I think I do know why it complained.
<Nutssh> blueshoe: But they don't do that for =. So they had a choice. EIther have one function for each type implementing '=' (messy), Define '=' on every type, even if it is ill-defined. (ocaml), or invent an exception in the typesystem (sml)
<blueshoe> well, as far as slm goes, the book says: "the designers of ML have chosen to infer that an equality type is needed by the presence of an operator = or <>, and they have chosen not to consider equality to nil as a special case. You may regard that choice as either "a bug or a feature" of ML, as you wish."
<blueshoe> /slm/sml
<Nutssh> There might be a fourth option out there, maybe a higher order type system?
<Smerdyakov> Nutssh, are type classes on of the options you've given?
<Smerdyakov> s/on/one
<blueshoe> the book also says "ML has a built-in function 'null' that tests whether a list is empty without requiring that list to be of an equality type."
<Nutssh> Smerdyakov: You mean tyep systems that are a generalizatio of hindley-milner? Higher order? No.
<blueshoe> i don't see why [] is an exception, though... isn't it covered by the definition of 'a list?
<blueshoe> and sml has no problems handling both ints and boolean values in a single = operator
<blueshoe> so not sure where exceptions to the type system come in to play here, and why [] is so special
<ayrnieu> let null = function [] -> true | _ -> false;;, of course.
<Nutssh> I"m not sure. A 'a list isn't an equality type is it, even if the 'a is an equality type. Can you do [12]=[12]?
<blueshoe> a list consisting of equality types is an equality type in sml
<Nutssh> [] is an open type. Take your function above and do 'l:int list' and your problem will probably go away.
det has joined #ocaml
<blueshoe> oh, i think i understand
det has quit [Remote closed the connection]
<blueshoe> you're saying that [] is ambiguous in its type and a real instance of a list [1;2;3], say, is of a determinate type?
<blueshoe> and that's why [] is an exception?
<ayrnieu> Nutssh - Smerdyakov probably does indeed mean that, thinking of Haskell and Mercury with their typeclasses for such things. In Haskell you'd define an Eq typeclass, for instance, which any type may subscribe to.
<Nutssh> Yes.. ANd ah-ha, I think I know what the problem is. You need equality types when you're comparing elements of an abstract type with equality. But as you're not doing anything else with them, they can still be mostly abstract.
<blueshoe> but why can't [] be compared to itself?
<blueshoe> if [] = []
<Nutssh> It is an open type.
<blueshoe> that should work, no?
<Nutssh> Try if ([]:int list) = []
<ayrnieu> blueshoe - don't confuse Pervasives.= with pattern matching =)
<blueshoe> ayrnieu, i'm not
<blueshoe> [] = [] should evaluate to true, no?
<blueshoe> i don't see why you need to specify the type of the list by saying ([]:int list)
<blueshoe> why would that help if you're comparing [] to itself?
<Nutssh> Yes, No, Maybe. I'd trust the designers of the language over an off-the-cuff judgement by myself.
<Nutssh> blueshoe: Because [] is an open type. By exlplicitly declaring it to be a closed type you avoid the problem.
<blueshoe> i hope i didn't give the impression that i was questioning the designers of the language... i'm simply trying to understand
<ayrnieu> blueshoe - of course ([] = []) evaluates to true, but you don't have ([]=[]), you have (x=[]) -- giving a function of 'a list, which has exactly the same problems as = itself, which Nutssh has spoken of.
<Nutssh> I'm not going to explain why. I'm not sure myself. If you still wish to know, learn some type theory, or google for it, or post a message.
<blueshoe> ayrnieu, it's true that x=[] is ambiguous as to its type, but if each side of that expression has 'a list as the type, why would it matter? [] is ambiguous as to its type, so it should match any 'a list, right?
<ayrnieu> bah, I've explained myself poorly -- I didn't mention '_a list', for instance.
<blueshoe> i don't mean any 'a list
<blueshoe> i meant any 'a list's []
<blueshoe> or, maybe not
<blueshoe> hmmm
<blueshoe> yes, to me it makes sense that [] should match any 'a list's []
<blueshoe> nutssh, well, thanks for trying to explain eariler... i see that this is a complex issue, and i do intend to study type theory at some point... maybe then it will all make sense :)
<Nutssh> ayrnieu: The exact reasons are subtle, If you are that interested in them, google and read papers on equality type and the type system of sml. If you have a complaint about the language, discuss it with them.
<Nutssh> blueshoe: :) You should have said that about 20 lines ago, before rambling off, but I appreciate it.
<blueshoe> well, it's interesting anyway
wazze 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"]
<blueshoe> even if we come to no conlusion
<blueshoe> conclusion
<blueshoe> at least i do know that sml and ocaml differ on this point
<blueshoe> and ocaml's = operator doesn't mind [] as one of its operands
<Nutssh> That is a combination of open types, a hack '=' in the language, and a hack in the type system.
<ayrnieu> Nutssh - er, a complaint? I haven't mentioned one.
<Nutssh> Erf. Not sure how I accidently put your name in that. Sorry.
<blueshoe> hmmm... well, actually sml doesn't mind [] as one of ='s operands, but it does complain when what it tries to apply the = to is a list of functions rather than a list of equality types
<blueshoe> and ocaml doesn't mind
<blueshoe> so i'll just keep that behvior in mind, and put my curiosity as to why on the back burner
<Nutssh> Functoins are not comparable for equality.
<blueshoe> i wasn't complaining either
<Nutssh> Anyways, would you be willing to do me a favor? Happen to know perl?
<blueshoe> nutssh, well, ocaml does accept a list of functions as an operand to the = operator, so it can match against []
<blueshoe> nutssh, i used to know perl... i've forgotten most of it
<Nutssh> Because ocaml defines = for all types, even nonsensical ones like 'int -> int'.
<ayrnieu> Nutssh - what do you want with Perl?
<blueshoe> but would it know that "int -> bool" is not the same as "int -> int"?
<Nutssh> You know enough. :) I would like a program that can translate http://www.merchantsoverseas.com/wwwroot/gorilla/bigevil.cf into a list of ordinary unescaped strings.
<blueshoe> i recognize that two funcions with type "int -> int" may not be the same, except to the type system
<blueshoe> what kind of strings?
<blueshoe> c, null terminated strings?
<Nutssh> blueshoe: You're confusing type equality with object equality. It is uncomputable to determine if two objects of type 'int -> int' compute the same function, thus equality is undefined.
det has joined #ocaml
<Nutssh> Look at the URL. Major problem is that some of the strings are left-factored. a(b|c|d) should be ab ac ad.
<blueshoe> nutssh, i'm not confusing the two... that's why i said: <blueshoe> i recognize that two funcions with type "int -> int" may not be the same, except to the type system
<Nutssh> They're never the same. Their types may be.
<det> what is the ocaml for of the folowwing sml code: "fun x a = b a and b a = x a"
<Riastradh> det, let rec x a = b a and b a = x a
<Nutssh> # let rec x a = b and b a = x a;;
<Nutssh> This expression has type 'a -> 'b but is here used with type 'b
<blueshoe> nutssh, you're looking to expand those expressions so that a(b|c|d) turns in to ab ac ad? just the case of that particular syntax, a(b|c|d), or all the other syntax expressions there like b(?:foo) ?
<Nutssh> (its complaining about 'x a' at the end.)
<det> oh, I was forgetting the rec kw
<Riastradh> Nutssh, yes, it's not well-typed. That function is inherently ill-typed.
<Nutssh> blueshoe: Yes. I want to undo the left-factoring by him. The \b and (: is noise.
<det> Nutssh: yeah, I was just looking for syntax help :)
<blueshoe> <Nutssh> They're never the same. Their types may be. <- well, they may be the same, such as: "let foo x = 1" and "let bar = 1" are really the same, but i understand ocaml isn't going to know that... all it can do is match its type, which doesn't tell you what operations are performed in the body of the function
<blueshoe> or, better yet, "foo = foo" should evaluate to true, since foo is the same function
<Nutssh> Take it up with the language designer.
<Smerdyakov> That's not very referentially transparent!
<blueshoe> nutssh, the perl program you want can probably be written.... but it would take some time
ayrnieu has left #ocaml []
<blueshoe> nutssh, when i say "should evaluate to true", this is not a criticism or even a suggestion as to what the language should do... it's just a human evaluation of the equivalence of the two functions
<blueshoe> i realise the language doesn't know that, and i don't expect it to
<blueshoe> all it knows about is the types, and i'm ok with that
<Nutssh> I know it could be written. I am working on the software that would use the output.
<blueshoe> spamming software? ;)
<blueshoe> this looks like it's used for spamassasin... could you just rip some code out of that?
<Nutssh> No. Actually an automatic factorization program that will do a much better job than the manual hacking currently done.
<blueshoe> well, if you give me the exact rules that this uses, like whether \b3 has any significance and whether the string you want starts immediately after "(?:" then i might be able to whip something up
<blueshoe> or does the string start immediately after the \b
<blueshoe> ?
<blueshoe> it could be done in ocaml, no?
<blueshoe> ocaml has a regex module, doesn't it?
<Nutssh> \b doesn't matter. See the perl regexp manpage for the exact syntax. (: just means non-capturing. It could be done in just about any language.
<blueshoe> so why don't you do it in ocaml?
<blueshoe> why look to perl?
<Nutssh> I don't care what it is written in. I just want the output. :)
<blueshoe> and why don't you write it?
<blueshoe> since you know ocaml very well
<Nutssh> <Nutssh> I know it could be written. I am working on the software that would use the output.
<blueshoe> so you're saying you don't have time to do it?
<Nutssh> Given that I'm doing an automata generator on th side, it will need to be done, but I'd like to spend my time on other parts of the poject.
<blueshoe> i see
<Nutssh> Nevermind. I'll do it myself. Be faster than to discuss it for the next 30 minutes.
<blueshoe> heh
<blueshoe> sorry, don't mean to whine about it
<Nutssh> It doesn't matter.
<Nutssh> And I got to go.
<blueshoe> see you, nutssh
Nutssh has quit ["Client exiting"]
<blueshoe> so what does 'a_ mean?
<blueshoe> err.. i mean '_a
<blueshoe> as in: '_a list
<blueshoe> how does it differ from plain old 'a ?
<vect> the type will be computed the first time the function will be called, and wont change after that
<blueshoe> ah, i see
<vect> IIRC
<blueshoe> now, why would that happen?
<blueshoe> why can't it stay 'a ?
<vect> don't remember.. didn't practice since 2002 ..
<blueshoe> me too :)
<blueshoe> i've come back to it just recently
<blueshoe> unforntunately i don't see the language having grown in popularity all that much in the past year
<blueshoe> i think it winning some icfp contests and doing well in the language shootout got a lot of people interested in it
<blueshoe> but nothing like that has happened for a while
<blueshoe> it would suck to have the language popularity fall off further from where it is now
<blueshoe> so i was thinking about a useful app or library to write
<blueshoe> maybe i'll write an editor
<blueshoe> the world needs another editor
tomasso has quit ["Leaving"]
<teratorn> omg no
<teratorn> oh, you're joking. :)
<teratorn> write a wicked ocaml<->python integrator. that would get it used by a lot of people I know :)
phj has joined #ocaml
emu has joined #ocaml
<emu> does anyone use tuareg mode? I am trying to figure out where the font color for module names is set... as in "module NAME = ..."
housetier has quit [Read error: 110 (Connection timed out)]
<emu> also, i have a Makefile for the code... how do I get ocaml to load it so I can work with it interactively... are there any tools for loading groups of files into a running session?
housetier has joined #ocaml
<blueshoe> teratorn, yeah, i was joking
<blueshoe> emu, try: #use "myfunctions.ml";;
<blueshoe> include the #
<blueshoe> and, as far as Makefiles go, you don't usually load the Makefile in to ocaml
<blueshoe> you feed the Makefile to make, and make compiles your code
<det> emu: here ?
<det> emu: did you install tuareg mode with apt?
<emu> yes
<emu> blueshoe: it's a lot of files
<det> emu: do you get syntax highlighting ?
<det> I get no syntax highlighting for tuareg OR caml mode
<det> everything else gets it however
<blueshoe> vim has syntax hilighting for ocaml code
<blueshoe> come on, i know you want to use it! ;)
<blueshoe> first taste is free
<det> I have used vim much :)
<blueshoe> ah! one of the saved!
<blueshoe> emu, try this:
<blueshoe> write a series of #use "myfile.ml" statements and put them in to a file
<blueshoe> then, in the ocaml toplevel do #use "script"
<det> hmm
<blueshoe> where "script" is the name of the file containing all your other #use directives
<det> apparently requiring caml-font gives caml mode syntax highlighting
<blueshoe> or, alternatively you could just compile your program using the standard Makefile
<blueshoe> or run "ocaml script"
<blueshoe> wow, there's a lot of spam in the caml list archives
<blueshoe> would be filterable if i had a subscription, but wading through the web archives is tough with all the spam
<blueshoe> ah... i see now that it's been fixed
<emu> "ocaml script"?
blueshoe has quit [Read error: 104 (Connection reset by peer)]
<emu> i am trying to avoid the whole 'switch to term; type make' syndrome
<emu> something like CM would be nice..
blueshoe has joined #ocaml
phj has quit [Read error: 54 (Connection reset by peer)]
blueshoe has quit [Read error: 104 (Connection reset by peer)]
blueshoe has joined #ocaml
Nutssh has joined #ocaml
Nutssh has quit ["Client exiting"]
Nutssh has joined #ocaml
buggs^z is now known as buggs
blueshoe has quit [Read error: 104 (Connection reset by peer)]
blueshoe has joined #ocaml
blueshoe has quit [Remote closed the connection]
blueshoe has joined #ocaml
blueshoe has quit [Client Quit]
blueshoe has joined #ocaml
karryall has quit ["."]
blueshoe has quit [Client Quit]
blueshoe has joined #ocaml
blueshoe has quit [Client Quit]
blueshoe_ has joined #ocaml
blueshoe_ has quit [Remote closed the connection]
blueshoe_ has joined #ocaml
Tamagucci has joined #ocaml
blueshoe_ is now known as blueshoe
whiskas has joined #ocaml
<whiskas> Mornin'
<Nutssh> Hi.
gim_ has joined #ocaml
blueshoe has quit [Read error: 54 (Connection reset by peer)]
blueshoe_ has joined #ocaml
blueshoe_ has quit [Client Quit]
blueshoe has joined #ocaml
Nutssh has quit ["Client exiting"]
Kinners has joined #ocaml
blueshoe has quit [Read error: 104 (Connection reset by peer)]
blueshoe has joined #ocaml
whiskas has quit [Remote closed the connection]
buggs^z has joined #ocaml
mimosa has joined #ocaml
buggs has quit [Read error: 60 (Operation timed out)]
blueshoe has quit ["[BX] I got sucked into /dev/null!"]
blueshoe has joined #ocaml
gim has quit [Read error: 104 (Connection reset by peer)]
whiskas has joined #ocaml
Swynndla has quit ["Leaving"]
whiskas has quit [Read error: 54 (Connection reset by peer)]
whiskas has joined #ocaml
whiskas has quit [Remote closed the connection]
whiskas has joined #ocaml
Demitar has joined #ocaml
ott has joined #ocaml
_JusSx_ has joined #ocaml
blueshoe has quit [Read error: 104 (Connection reset by peer)]
blueshoe has joined #ocaml
Kinners has left #ocaml []
Nutssh has joined #ocaml
_JusSx_ has quit ["[BX] The FDA says 5 servings of BitchX a day increases sexual potency"]
cjohnson has joined #ocaml
gim has joined #ocaml
whiskas has quit ["Leaving"]
mattam_ has joined #ocaml
whiskas has joined #ocaml
mimosa has quit [Read error: 60 (Operation timed out)]
mattam has quit [Read error: 110 (Connection timed out)]
Nutssh has quit ["Client exiting"]
Tamagucci has left #ocaml []
mattam_ is now known as mattam
stupid_me has joined #ocaml
whiskas has quit [Nick collision from services.]
stupid_me is now known as whiskas
karryall has joined #ocaml
<blueshoe> too bad so much functional programming lit is written with haskell and lisp in mind and as examples
<blueshoe> means i'm going to have to eventually learn those languages, even if i don't feel the need to for any other purpose than to read more on fp
<Maddas> blueshoe: Learning those is not something bad
<blueshoe> i agree, if you have the time
<Maddas> blueshoe: Rather, it should teach you a lot even if you never use them
<blueshoe> i am having a hard enough time as it is making time to learn ocaml
<Maddas> Ah, I see. It certainly takes time
<blueshoe> yeah
<blueshoe> i'd love to learn everythign, ideally :)
<Maddas> SICP is a great book if you plan learning / don't mind Scheme
<blueshoe> i have sicp, and their lectures on video
<Maddas> heh
<blueshoe> i started learning it
<blueshoe> but got caught up w/something else
<blueshoe> i think maybe math
<blueshoe> that's another thing i have to learn
<blueshoe> my math abilities suck, and i really need a lot of work there... more time
<Maddas> :)
<whiskas> I'm cool with my factorial function so far :-P
mimosa has joined #ocaml
beleg has joined #ocaml
ott has quit ["×ÁÌÉÔØ"]
<Maddas> hum
<Maddas> I do not understand something inferred by the type checker
<Maddas> Does anybody mind looking?
<whiskas> Sure, but I doubt I'll be of any help :-(
<blueshoe> same here
<Maddas> I'm convinced that the error is very obvious
<Maddas> :-)
<blueshoe> ok, shoot
<Maddas> The last line was added later on, it didn't help.
<Maddas> The typechecker says it expects type unit, not int list
<Maddas> $ is compose
<Maddas> let ($) f g = fun x -> f (g x)
<blueshoe> i get "Unbound value $"
<Maddas> Heh, I'll paste the entire script then
<Maddas> just a second
<blueshoe> i don't even know what $ does
<Maddas> I just told you :-)
<Maddas> It's just syntactical sugar
<Maddas> f (g x) is the equivalent of (f $ g) x
<karryall> Maddas: because the while loop expression evaluates to unit
<karryall> you hsould write things like this :
<blueshoe> oh, i didn't see that
<karryall> begin while true do things done with Exit -> () end ; !return_value
<Maddas> oh
<Maddas> karryall: hm, ok
<Maddas> blueshoe: so instead of writing f (g (h (i x))) I write (f $ g $ h $ i) x
<blueshoe> yes, i understand
<blueshoe> i just didn't see you say it until later
<blueshoe> in cosineau and mauny, iirc, they refer to that function as "fog"
<blueshoe> or "f of g"
<Maddas> heh
<Maddas> I think it's just called function composition in Haskell
tomasso has joined #ocaml
<Maddas> hm, karryall, I don't understand
<Maddas> wrapping the thing in a begin .. end didn't work, so I assume I did it wrongly
<karryall> I forgot the try
<whiskas> Umm, f o g = g(f(x)); At least, that's what Maths says.
<Maddas> oh, something worked, karryall :)
<karryall> begin try while true do ... done with Exit -> () end ; ...
<Maddas> yeah
<karryall> whiskas: yes "usually" it's let ( $ ) f g = fun x -> g (f x)
<whiskas> Aah, ok.
<blueshoe> why do you write it that way and not: let ( $ ) f g x = g ( f x )
<blueshoe> ?
<Maddas> blueshoe: maybe there will not be any x
<Maddas> oh, duh
<Maddas> never mind
<blueshoe> never mind for me too
<blueshoe> i think i understand
<Maddas> and I think I got the operator the wrong way round
<blueshoe> g can be a function that takes an x as an argument on its own
<blueshoe> independent of f
<blueshoe> anyway, i should sleep
<karryall> blueshoe: these two ways of writing $ are completely equivalent
<blueshoe> karryall, they are?
<Maddas> my function is just an alias for compose
<Maddas> but compose is too long to use often and infix notation is handy :-)
<blueshoe> ok, i'm going to bed... night everyone
<Maddas> night
<whiskas> Bubye.
Hadaka has quit [brunner.freenode.net irc.freenode.net]
Hadaka has joined #ocaml
Hadaka_ has joined #ocaml
Hadaka has quit [Read error: 54 (Connection reset by peer)]
Hadaka_ is now known as Hadaka
blueshoe has quit [Read error: 104 (Connection reset by peer)]
karryall has quit ["."]
whiskas has quit ["Leaving"]
cjohnson has quit ["Drawn beyond the lines of reason"]
wazze has joined #ocaml
whiskas has joined #ocaml
beleg has left #ocaml []
<whiskas> Waaaaaaaaaaaaaakke uuuuuuuuuuuuuup!
blueshoe has joined #ocaml
<whiskas> :-p
<whiskas> blueshoe: Shite, you're @ Berkeley?
<whiskas> Any of you head of Jason Hickley? 'cause that name sounds pretty familiar to me...
whiskas is now known as whiskas|off
<Smerdyakov> He's a professor at CalTech.
Whitie has joined #ocaml
Whitie has left #ocaml []
gim_ has quit [brunner.freenode.net irc.freenode.net]
smkl has quit [brunner.freenode.net irc.freenode.net]
smkl has joined #ocaml
gim_ has joined #ocaml
whiskas|off is now known as whiskas
<whiskas> Aah, thanks.
whiskas has quit [Remote closed the connection]
whiskas has joined #ocaml
ita has joined #ocaml
<ita> hi all
<whiskas> Hmm, the topic says that http://caml.inria.fr/bin/wilma/caml-list is the best mailing list ever for any computer language.
<whiskas> Hey ita.
<whiskas> Point is, the archives show up a lot of spam.
<whiskas> Now I'm convinced. It would definitely suck to subscribe to that ml.
<ita> cool, i just needed to enlarge my p3nI$ with V146R@
<ita> :)
<whiskas> Told ya.
buggs^z is now known as buggs
whiskas is now known as whiskas|food
whiskas|food is now known as whiskas|off
<mattam> there's was a misconfig at the servers side which allowed spam to go through, it is resolved now, though
<mattam> there was...
<whiskas|off> Aah, in that case, I migh subscribe.
<ita> if it happened it then past .. it may happen again
<mattam> well, you're absolutely right ita
<mattam> anyway, if you've got a local spam filter like SpamOracle it can handle this spam too
<ita> mozilla does it :)
blueshoe has quit [Read error: 104 (Connection reset by peer)]
whiskas|off has quit [Remote closed the connection]
cjohnson has joined #ocaml
whiskas has joined #ocaml
<whiskas> Hey.
qpps has joined #ocaml
qpps has quit [Client Quit]
det has quit [Read error: 110 (Connection timed out)]
<ita> how is named the type "Queue" (this is a module, right?), is that "queue" ? (like Array - array)
<Smerdyakov> Nope. Look in the signature of the Queue module.
<Smerdyakov> It should be clear from that.
<ita> errm ? is it written there -> http://caml.inria.fr/ocaml/htmlman/libref/Queue.html ?
<Smerdyakov> Yes.
<ita> how should i modify this then -> type empilement = {l : pos queue; mutable h : int };; ? (it won't work but i can't find :-/)
<Smerdyakov> So the signature of Queue didn't help you?
<Smerdyakov> You didn't see any mention of types there?
<ita> no, i haven't
<Smerdyakov> Not even as the very first member of the signature listed?
<ita> not even .. trying every word in the windows - nothing works
<Smerdyakov> You don't see this line?
<Smerdyakov> type 'a t
<ita> yes i see this line
blueshoe has joined #ocaml
<Smerdyakov> OK. That entry answers your question.
<ita> ... however "type empilement = {l : pos queues; mutable h : int };;" won't work - any idea :)
<ita> ?
<Smerdyakov> Yeah. Because no type queues is defined.
<Smerdyakov> The Queue signature tells you what the real type to use is.
<Smerdyakov> I just told you which entry describes it.
<ita> unit ?
<Smerdyakov> No, the entry says: type 'a t
<Smerdyakov> Do you not understand what it means for a module to have a type as a member?
<ita> ok, i'm afraid i don't really understand what "type 'a t " means
<Smerdyakov> It means that there is a member of module Queue that is a type. Its name is t, and it takes one parameter.
<ita> you can say i'm a moron, but i'm still stuck with that :-/
<Smerdyakov> Queue has a member called create. How do you reference that member?
<ita> using ref ?
<Smerdyakov> No. I mean "reference" in the usual English sense. How do you refer to it in code?
<ita> i don't know ?
<Smerdyakov> If you wanted to call the create function in Queue, how would you do it?
<Smerdyakov> OK. So you have been unable to use anything from Queue so far?
<ita> well, Queue.create
<Smerdyakov> OK, so you refer to the create member of Queue with Queue.create.
<Smerdyakov> Now, how do you refer to the t member of Queue?
<ita> Queue.t ?
<Smerdyakov> OK. That ought to answer your question. (he says again... :)
<ita> not yet .. why doesn't "type empilement = { l : Stack.t ; mutable h : int };;" work ? :-/
<mattam> you've got to say what is the type of the objects in your stack
<ita> oh
<ita> okay !
<mattam> i.e. Stack.t is paramatrized by the type of its objects, like Queue.t
<Smerdyakov> That's why it's "type 'a t", not just "type t".
<ita> mattam: thanks
<mattam> well, thanks to Smerdyakov, he's been much more helpful than me :)
<ita> Smerdyakov: you are so cryptic .. you could've just said "int ModuleName.t"
_JusSx_ has joined #ocaml
<Smerdyakov> ita, but then you might not have understood the module system, and it first I assumed you did but just didn't read documentation carefully enough.
<mattam> ita: he's right, believe me :)
<ita> mmm ok
blueshoe has quit [Read error: 104 (Connection reset by peer)]
det has joined #ocaml
mattam_ has joined #ocaml
mattam has quit [Read error: 60 (Operation timed out)]
<ita> dammit i still confuse ! with 'not'
Verbed has quit ["Leaving"]
shawn has quit [Read error: 104 (Connection reset by peer)]
mimosa has quit ["J'ai fini"]
mimosa has joined #ocaml
Heimdall has joined #ocaml
<Heimdall> Hello / Bonsoir
<Heimdall> I've got a problem with the implementation of a classical problem in O'Caml
whiskas is now known as whiskas|off
<Heimdall> I am looking for a bit of help...
<Riastradh> Just ask your question.
<Heimdall> Not a question
<Heimdall> My program takes about 12 lines
<Heimdall> compiles well
<Heimdall> And gives me correct output when used with euqal input values
<Heimdall> And Array.get fails if I try different inputs values...
<Heimdall> I just can't understand why it behaves so...
<Smerdyakov> That sure sounds like a question to me: "Why doesn't it work?"
<Heimdall> yes, it does
<Heimdall> but you need to look at my code first...
<Heimdall> Should I post it here ?
<Smerdyakov> Post it on the web and give the URL here.
<Heimdall> ok
<whiskas|off> rafb.net/paste
<Heimdall> thanks
<ita> Heimdall: sakado .. tu joues avec knapsack ? :)
Swynndla has joined #ocaml
<Smerdyakov> Heimdall, I suggest you re-read the manual's information on Array.iter. (If you look at the type, that should be enough information for a seasoned ML'er.)
<Smerdyakov> Well, that would be what would make print_array crash for you. It looks like you don't call it in that code, so if it crashes with that exact code, you have additional problems.
<whiskas|off> As far as I can tell (without ever using Array), Array.iter takes a function accepts any argument, returns () and a array whose elements are of the same type as the function's arguments.
<whiskas|off> Well, that didn't sound that nice.
<Smerdyakov> whiskas|off, no.
<whiskas|off> No?
<Smerdyakov> whiskas|off, no. What you said has nothing to do with Array.iter.
<whiskas|off> But the type is ('a -> unit) -> 'a array -> unit
<Heimdall> @ita : non, sakado vient de "sac à dos" : c'est un problème d'empaquetage
<Smerdyakov> whiskas|off, ah, maybe we have different ideas of operator associativity in English. :)
<ita> Heimdall: bah, c'est dans le même genre
<Heimdall> Smerdyakov, I deleted all the parts with print_array. I introduced it in order to debug but it did nt work
<Smerdyakov> whiskas|off, it looked to me like you said the function will return an array, instead of taking one as an argument.
<Smerdyakov> Heimdall, right, because you misused Array.iter.
<whiskas|off> Smerdyakov: Ok, let me rephrase; Array.iter takes of function f and an array of 'a; f takes an argument of 'a and return ().
<whiskas|off> s/return/returns
<whiskas|off> Smerdyakov: How's that for a change?
blueshoe has joined #ocaml
<Smerdyakov> whiskas|off, looks good to me!
<whiskas|off> Heh, thanks :-)
<Heimdall> I went from Caml Light to Objective just few days ago, so I am not used yet to strange Array operations...
<Smerdyakov> Heimdall, do you understand why Array.get would fail?
<Heimdall> Not quite
<Heimdall> Sorry
<Smerdyakov> It fails when the subscript you give is out of bounds.
<Heimdall> Yes, I understand that.
<Riastradh> Heimdall, you know that array indices are from zero, inclusive, to the size of the array, exclusive, right?
<Heimdall> yes
<Heimdall> I coded in Caml Light for two years
<Smerdyakov> I don't think many people here have ever used Caml Light, so that doesn't help us understand your problem better.
<Riastradh> You also know that [[for i = N to M do ... done]] will, in the body ..., bind i to all the numbers between N to M, inclusive and inclusive, right?
<Heimdall> Caml Light is just the same as Objective, save for Array manipulation
<Smerdyakov> Riastradh, he appears to have sized his array one element larger than necessary such that that works.
<ita> Heimdall: tu comptes pas t'attaquer au sacados multidimensionnel par hasard ?
<Riastradh> ...oh, ew.
<Smerdyakov> Riastradh, or maybe it doesn't work, but v.(0) is left unset forever. :)
<Heimdall> ita : non, pas franchement... Je m'initie à la programmation dynamique, pour l'instant
<ita> ok
<Heimdall> v.(0) = 0 forever, Smerdyakov
<Heimdall> That's normal
<Smerdyakov> OK, good.
<Smerdyakov> Heimdall, so it should be obvious to you what you should be doing now:
<Smerdyakov> Heimdall, you need to find the circumstances in which you do a bad array subscripting.
<Heimdall> delete the print_array lines ?
<Smerdyakov> No, the contents of print_array are irrelevant as long as it is never called.
<Heimdall> Tell me : how would you write a function that displays an array ?
<Smerdyakov> It's not possible to write a function that displays any kind of array without sending it a function to print the elements.
<Heimdall> ok, an int array, then
<Riastradh> You could write something like this:
<Smerdyakov> Then it looks almost like what you have there.
<Riastradh> let print_array print_element array =
<Smerdyakov> But you have misunderstood what Array.iter is, and you are doing too much as a result.
<Riastradh> Array.iter (...print_element elt...) ...
<whiskas|off> Well, shouldn't Array.iter call the function with every element in the array?
<Smerdyakov> Heimdall, you can make your print_array work by just _taking_out_ some code you have there. You don't need to add or otherwise change anything.
<Heimdall> the "fun x->" part was too much ?
<Smerdyakov> No, fun x-> is good.
<Smerdyakov> But you have misunderstood what values that function will be called with.
<Smerdyakov> It will NOT be called with increasing array indices.
<Heimdall> No ?
<Smerdyakov> That much is obvious from the type of Array.iter.
<Riastradh> Heimdall, [[Array.iter f array]] is just like [[begin f array.(0); f array.(1); ...; f array.(Array.size array - 1) end]].
<Heimdall> I believed so... :'(
<Smerdyakov> If the array has non-int elements, then clearly the function won't be called with int's.
<Smerdyakov> Do you see what I mean?
<Smerdyakov> This should all be clear from the type.
<Heimdall> yes, I believe I understand
<whiskas|off> Hmm, I don't get unions :-(
whiskas|off is now known as whiskas
<Smerdyakov> whiskas, what do you mean by "unions"?
<whiskas> Disjoint unions, variant records, tagged unions, those unions.
<Heimdall> That's great ! My function print_array works fine !
<Smerdyakov> whiskas, what don't you get about them?
<Heimdall> And what if I want to use two instructions in a row ?
<Smerdyakov> Heimdall, what do you mean?
<whiskas> Weel, rather the whole concept...
<Heimdall> Array.iter (print_int;print_newline) t;; doesn't work
<Heimdall> but Array.iter print_int t;; does
<Smerdyakov> That's because (print_int;print_newline) is the same as print_newline.
<Smerdyakov> ; is an operator that throws away its first operand.
<Smerdyakov> You had the code right the first time, save for removing a small amount of it.
<Riastradh> There were six characters that shouldn't have been there.
<Heimdall> (fun x->print_int; print_newline()) ?
<whiskas> Array.iter print_int some_array;;
<Riastradh> Heimdall, no...that will just print out a newline for each element.
<whiskas> I think that would work (provided that some_array is an array of ints).
<Heimdall> whiskas : I tried : it works
<Smerdyakov> whiskas, it wouldn't work if you want distinct arrays to have distinct output results.
<Riastradh> [[print_int; ...]] will ignore print_int and go on to evaluate [[...]].
The-Fixer has quit ["Goodbye"]
<whiskas> Smerdyakov: ?
<Heimdall> hum...
<Smerdyakov> whiskas, the arrays {1,0} and {10} would have the same output.
<Heimdall> Riastradh, I don't see how to give two instructions without using ";"
<Smerdyakov> Heimdall, what, now you have forgotten how to call a function?
<whiskas> Humm, what about this? Array.iter (fun x -> print_int x; print_newline) some_array?
<Riastradh> Heimdall, that's not the point...just plain [[print_int]] doesn't do anything, and the result of evaluating it is thrown away.
<Smerdyakov> whiskas, it is not good to give it away to him.
<whiskas> Smerdyakov: Give what to whom?
<Smerdyakov> whiskas, to Heimdall
<whiskas> Ooh, sorry :-(
<whiskas> Yeah, you're right.
<whiskas> Sorry again.
<Heimdall> Anyway, it doesn't work ;-)
<Smerdyakov> Yup, but it's very easy to fix.
<Heimdall> ok
<Heimdall> I'll try
<whiskas> Now, regarding those bloody unions...
* Smerdyakov wonders what kind of Caml Light Heimdall has been using for two years to be confused by this.
<Heimdall> Array.iter (fun x->print_int x; print_newline()) t;;
<Heimdall> does the work
<Smerdyakov> Heimdall, try and see.
<Smerdyakov> Oh, I read s/the/that.
<Smerdyakov> whiskas, what about them?
* Heimdall could do everything with just make_vect and t.(i)<-... ;-)
<whiskas> Smerdyakov: Well... could you spare your definition?
<Smerdyakov> whiskas, "type whatever = cons1 | cons2 | ... | consN" means that every whatever is one of consi.
<Heimdall> Just one thing before going away :
<Smerdyakov> whiskas, you can add arguments to the constructors, too.
* Heimdall thanks #ocaml !!!!!
<whiskas> Smerdyakov: That's what I don't get, the constructors part.
<whiskas> Heimdall: :-)
<Smerdyakov> whiskas, they're just names for different sorts of values of the type you're defining.
<Smerdyakov> For instance, this is literally how the boolean type is defined:
<Smerdyakov> type bool = false | true
<whiskas> I know, I know.
<whiskas> That I knew :-P
<Smerdyakov> So then what is it you don't know?
<whiskas> Hmm, I think I'm missing the view of the forest because of the trees.
Heimdall has quit []
<whiskas> Yay, I just defined a binary tree :-)
The-Fixer has joined #ocaml
<Smerdyakov> I haven't yet understood what it is you don't understand. Do you still have a question?
<whiskas> Not really, I don't think so. But thanks anyway.
buggs is now known as buggs^z
<whiskas> Crap.
<whiskas> let 'a btree = Node of
<whiskas> argh
<whiskas> type 'a btree = Node of 'a btree * 'a * 'a btree | Leaf;;
<whiskas> though I can't let x = Node(Leaf, 5, Leaf);;
<whiskas> Hints?
<Smerdyakov> You can't? O_o
<Riastradh> # type 'a btree = Node of 'a btree * 'a * 'a btree | Leaf;;
<Riastradh> type 'a btree = Node of 'a btree * 'a * 'a btree | Leaf
<Riastradh> # let x = Node(Leaf, 5, Leaf);;
<Riastradh> val x : int btree = Node (Leaf, 5, Leaf)
<whiskas> What the heck?
<whiskas> This is the second time O'Caml acts weird.
<Riastradh> What's it doing?
<whiskas> I'm pretty sure I typed exactly what you said above.
<Riastradh> And...?
<whiskas> Neah, I'm more then sure, 'cause I have the history.
<whiskas> And it gave me "This expression has type 'a btree but is here used with type 'b btree" when I tried Node(Leaf, 5, Leaf);;
<Riastradh> ...??
<whiskas> Yeah, I don't know, even.
<Riastradh> Paste the _exact_text_.
<Riastradh> (just as I did)
<whiskas> # type 'a btree = Node of 'a btree * 'a * 'a btree | Leaf;;
<whiskas> # let my_tree = Node(Node(Nil, 5, Node(Nil, 7, Nil)), 3, Nil);;
<Riastradh> ...no, both input lines and responses.
<whiskas> Characters 24-27:
<whiskas> let my_tree = Node(Node(Nil, 5, Node(Nil, 7, Nil)), 3, Nil);;
<Riastradh> Um.
<Riastradh> Nil?
<whiskas> Ok, wait.
<whiskas> # type 'a bree = Node of 'a btree * 'a * 'a btree | Leaf;;
<whiskas> type 'a bree = Node of 'a btree * 'a * 'a btree | Leaf
<whiskas> # Node(Leaf, 5, Leaf);;
<whiskas> Characters 5-9:
<whiskas> Node(Leaf, 5, Leaf);;
<whiskas> ^^^^
<whiskas> This expression has type 'a bree but is here used with type 'b btree
<whiskas> That's the code.
<Riastradh> bree?
<whiskas> Oops
<whiskas> Ok, then crap again.
<whiskas> I should go to sleep.
<whiskas> Sheesh, really can't believe this.
<whiskas> Sorry for all the inconvenience.
<ita> ---> /dev/bed
<whiskas> Yeah, so it seems.
<whiskas> sleep(1000 * 8 * 3600);
<Riastradh> cat whiskas >>/dev/bed && rm -f whiskas
<Maddas> Riastradh: better set a cron to bring him back.
<whiskas> Riastradh: Ooh? Why would you want to do that?
<whiskas> I don't trust cron. Please don't rm me :-(
<whiskas> :-P
<Riastradh> I moved him to /dev/bed and removed what was left of him here.
<whiskas> So I take it you want me to leave?
<Riastradh> You can always fetch him back from /dev/bed and put him elsewhere.
<ita> to /dave/null
<whiskas> dd if=/dev/sleep of=/dev/whiskas count=8H
whiskas has quit ["Leaving"]
Demitar has quit [Remote closed the connection]
mimosa has quit ["J'ai fini"]
Nutssh has joined #ocaml
mimosa has joined #ocaml
<ita> mmm looks like i've sucessfully ported my algorithm to caml
<Maddas> yay
<Maddas> :)