Yurik changed the topic of #ocaml to: http://icfpcontest.cse.ogi.edu/ -- OCaml wins | http://www.ocaml.org/ | http://caml.inria.fr/oreilly-book/ | http://icfp2002.cs.brown.edu/ | SWIG now supports OCaml| Early releases of OCamlBDB and OCamlGettext are available
<mrvn> weil f ja auch irgendeinen type haben muss
<pattern> you lost me, mrvn
<whee> oh, I'm an idiot
<mrvn> (g x) ist 'd --> f (g x) muss 'd->'f sein
<mrvn> all together: let compose (f:'d->'f) (g:'b->'d) (x:'b)
Kinners has joined #ocaml
<mrvn> And then its just renaming them to be in order 'a 'b 'c
<phubuh> pattern: it thinks that g is a function because you're applying it with x as the argument
<phubuh> let compose f g x = f g x is probably what you want
<mrvn> phubuh: no
<mrvn> pattern: Should I repeat the process?
<pattern> in english, and slowly, please :)
<phubuh> # let compose f g x = f g x;;
<phubuh> val compose : ('a -> 'b -> 'c) -> 'a -> 'b -> 'c = <fun>
<phubuh> # compose (+) 5 3;;
<phubuh> - : int = 8
<whee> that's not the same
<phubuh> oh, that's what i parsed from pattern's description. sorry.
<pattern> # let compose f g x = f (g x) ;;
<pattern> val compose : ('a -> 'b) -> ('c -> 'a) -> 'c -> 'b = <fun>
<pattern> # let add1 x = x+1 and mul5 x = x*5 in compose mul5 add1 9 ;;
<pattern> - : int = 50
<mrvn> pattern: Ok, first each argument just gets a type.
<mrvn> let compose (f:'a) (g:'b) (x:'c) compose:'a->'b->'c->'d
<mrvn> pattern: let inc = (+) 1 let add1 = inc
<mrvn> let mul5 = (*) 5
<pattern> what is f:'a ?
<mrvn> pattern: you understand the first step?
<mrvn> f with type 'a
<pattern> where dif 'f' come from?
<pattern> no i don't understand
<pattern> and i don't understand ':' either :(
<mrvn> pattern: you had let compose f g x
<pattern> yes
<mrvn> pattern: (var : type) is the syntax to tell ocaml what type something has
<pattern> ah
<pattern> ok, sorry
<pattern> i'm with you now
<mrvn> Ok, first we just give everything a different type.
<mrvn> let compose (f:'a) (g:'b) (x:'c) compose:'a->'b->'c->'d
<mrvn> Now we look at the innermost function and work our way outward
<pattern> wait
<pattern> wiat
<pattern> i understand (f:'a) (g:'b) (x:'c)... each variable gets a type
<pattern> but how did we get from that to 'a->'b->'c->'d ?
<mrvn> compose is thus a function taking 3 arguments returning a fourth.
<pattern> where did the 'd come from?
<mrvn> every function returns some type.
<mrvn> Ok, the very first step would be: (compose : 'z). but hey, compose is a function with 3 arguments => 'a->'b->'c->'d
<pattern> ok, so the fourth argument 'd comes from the right hand side of: let compose f g x = f (g x) ;;
<pattern> ?
<mrvn> pattern: 'd is the result.
<pattern> from f (g x) ;; ?
<mrvn> in this case yes.
<pattern> ok
<pattern> i think i'm following you
<mrvn> But ocaml hasn't looked at the right hand side yet. Just the = is enough.
<pattern> thanks for taking this slow with me, btw :)
<mrvn> The innermost thing is (g x)
<pattern> ok
<mrvn> What type must g have then?
<pattern> function?
<mrvn> (g:'e->'f)
<mrvn> but 'e must be 'c because the argument x has that type
<mrvn> let compose (f:'a) (g:'c->'f) (x:'c) compose:'a->('c->'f)->'c->'d
<pattern> wait
<pattern> 'e must be 'c because x has which type? type 'e ?
<mrvn> no, other way. (g:'e->'f) and (x:'c) -- (g x) => 'e == 'c
<phubuh> the parameter x has type 'c, and because g is passed x, g must take a parameter of type 'c
<mrvn> do you follow?
<pattern> i'm trying to... i need another second
<mrvn> x has type 'c and you call g with x => g is a function taking a 'c retuning something else ('f)
<pattern> ok, one thing that's confusing me now is if we're still talking about hte left hand side
<pattern> # let compose f g x = f (g x) ;;
<mrvn> no, right hand side.
<pattern> ok
<pattern> so, the right hand side gets it's own 'a 'b and 'c ?
<mrvn> actually just about (g x)
<pattern> because didn't f g and x get 'a 'b and 'c already?
<pattern> (on the left hand side)
<mrvn> that was our first guess.
<mrvn> But (g:'b) doesn#t quite work. g is a function, which means that 'B must be of the form 'c->'f
<pattern> oh, so the right hand side can change what we think the left hand side should be typed as?
<mrvn> 'b even
<mrvn> exactly.
<mrvn> As we get more information about the type we replace the old types with more accurate ones.
<pattern> i see
<mrvn> from (g x) we deduce that 'b = 'c->'f
<mrvn> so we replace that:
<mrvn> let compose (f:'a) (g:'c->'f) (x:'c) compose:'a->('c->'f)->'c->'d
<pattern> hold on... sorry
<pattern> which 'b are you talking about?
<mrvn> there is only one 'b
<phubuh> there is only one 'b
<phubuh> heh
<mrvn> all 'b are one
<pattern> 'b is g ?
<mrvn> g has the type 'b
<pattern> so why do you say 'b = 'c->'f ?
<pattern> we don't have g = ???
<mrvn> thats the only way 'b works with (g x)
<pattern> we have f g x = f (g x) ;;
<pattern> i'm so confused
<phubuh> x has the type 'c, so g has to accept a 'c, because we pass x to it
<mrvn> 'b could be anything, like "int array" or "char list" or "'c -> 'f" in this case
<pattern> oh, ok
<pattern> wait, but what happened to 'e ? is 'e f ?
<mrvn> Ok, now we know that (g x) results in type 'f
<mrvn> pattern: no, 'e was just temporary but we saw that it must be 'e = 'c to fir (g x)
<pattern> so why say 'c -> 'f ?
<pattern> why not say 'c -> 'e ?
<pattern> ...if 'd was the right hand side in total
<mrvn> pattern: because we had 'e->'f
<mrvn> as the guess for g
<pattern> i think i need to write this down
<mrvn> pattern: doesn't matter if you call it 'e 'f 'z or whatever letter you desire. As long as you don#t use one thats already taken for something else.
<pattern> ok, but i didn't know 'e was being used for anything
<pattern> i thought we decided we couldn't use it
<pattern> and now i've forgotten why :)
<mrvn> didn't want to reuse it
<mrvn> g has type 'c->'f and x has type 'c. Therefore (g x) results in a 'f
<pattern> yes, i understand that
<pattern> i just got confused on where 'e came from and where it went
<mrvn> f (g x) Thus f is a function taking an 'f
<pattern> but i understand that you're assigning 'f because it's the next free letter
<mrvn> (f:'f->'g)
<pattern> yes, that makes sense
<mrvn> pattern: yep, allways the next free letter
<mrvn> So we replace all 'a with 'f->'g
<mrvn> ('f->'g) rather
<mrvn> let compose (f:'f->'g) (g:'c->'f) (x:'c) compose:(''f->'g)->('c->'f)->'c->'d
<mrvn> Thats all we can deduce typewise so now we make it pritty again:
<pattern> why do both g and x use 'c ?
<mrvn> because x is passed to g as an argument.
<pattern> isn't that breaking the rule?
<mrvn> the type must match
<pattern> oh, ok
<pattern> is ''f a typo?
<mrvn> yep.
<mrvn> Oh, I forgot one step: f (g x) results in type 'g
<mrvn> => The result of compose has type 'g
<mrvn> let compose (f:'f->'g) (g:'c->'f) (x:'c) compose:('f->'g)->('c->'f)->'c->'g
<mrvn> follow?
<pattern> kind of
<pattern> i think i need to take the original expression and try to decompose it myself, using this method
<pattern> and then come back with more questions when i fail miserably :)
<mrvn> Now we apply some makeup: 'f ==> 'a, 'g ==> 'b
<mrvn> val compose : ('a -> 'b) -> ('c -> 'a) -> 'c -> 'b = <fun>
<pattern> wouldn't it just be easier to make your types explicit?
<phubuh> it wouldn't be very useful then
<pattern> what does type inference buy you if the whole process is so complicated to follow?
<mrvn> pattern: it safes you an awfull lot of typing.
<pattern> it's easier to say "function f" instead of figuring out what you're hoping ocaml will think it is
<mrvn> pattern: what type of function?
<whee> in that form, compose works on an awful lot of inputs
<pattern> hmmm
<whee> restricting it would make it somewhat useless
<phubuh> pattern: if you didn't have type inference, you would have to infer types yourself, which is what we've been doing now
<phubuh> and type all of that explicitly, making things a lot less readable
<pattern> well, i have to infer myself to understand what i've written when i say compose f g x = f (g x)
<whee> well yes you have to know what it does, but you don't have to tell the compiler
<whee> because the compiler can go and figure that one out with type inference
<pattern> yeah, i just thought if you told it somehow that g and x are arguments to f, it would all be simple
<pattern> anyway, it's irrelevant... this is how it is... and i just have to learn it
<pattern> so i'm going to go try to work out the types of this statement for myself
<pattern> thanks for showing me the way, mrvn
<mrvn> cdecl> declare compose as function (function (double) returning int, function (char) returning double, char) returning int
<mrvn> int compose(int (double ), double (char ), char )
<mrvn> Do you think that makes it more clear that not writing types?
<pattern> yes!
<pattern> god yes!
<mrvn> And thats with simple types and not complex types that are in itself functions again
<pattern> hmmm
<whee> 'a compose('a ('b ), 'b ('c ), 'c)
<whee> :)
<pattern> well, you have to understand what you're writing anyway... so it's virtually the same as making the types explicit, except that you save on typing, as phubuh says
<pattern> but i think the program would be more readable, not less, were the types explicit
<pattern> maybe i'll change my mind once i learn this and practice it a few times, though :)
<phubuh> once you get used to the type inferring, you'll feel if the compiler can figure out exactly what you mean
<pattern> that's cool
<pattern> right now i feel the opposite, though :)
<pattern> i really appreciate you guys helping out, btw
<phubuh> have you coded in any other functional language?
<pattern> there's no way i could have understood this from the meager notes in the ocaml book and tutorial
<pattern> no, i never have
<pattern> i've learned a ton of imperative languages... but never functional or even oo
<mrvn> # let rec translate f g h = f (g (h)) and calc_as_float f = translate int_of_float f float_of_int;;
<mrvn> val translate :
<mrvn> (float -> int) -> ((int -> float) -> float) -> (int -> float) -> int =
<mrvn> <fun>
<mrvn> val calc_as_float : ((int -> float) -> float) -> int = <fun>
<phubuh> =)
<mrvn> # let rec translate f g h x = f (g (h x)) and calc_as_float f = translate int_of_float f float_of_int;;
<mrvn> val translate :
<mrvn> Thats what I ment.
<mrvn> (float -> int) -> (float -> float) -> (int -> float) -> int -> int = <fun>
<mrvn> val calc_as_float : (float -> float) -> int -> int = <fun>
<mrvn> ocaml sees itself that "calc_as_float" takes a function and returns a function
<mrvn> # let inc = (+) 1;;
<mrvn> val inc : int -> int = <fun>
<mrvn> much easier than int inc(int x) { return x + 1; }
<pattern> i hope someone followed that... because i didn't :0
<pattern> i need to grasp the simple example first
<pattern> i'll bbl, and then maybe i'll be ready to tackle your calc_as_float
<mrvn> pattern: the best thing of functional languages is that a type can be a value or a function. Makes no difference.
<pattern> yeah, i like that
<mrvn> And the parameters of a function can be locked together to have certain types.
<mrvn> # List.map;;
<mrvn> - : ('a -> 'b) -> 'a list -> 'b list = <fun>
<pattern> i can definately see the power of that already
<mrvn> The first parameter is a function from 'a to 'b. Can be anything. But then the second paraemter must be a list of the type 'a used for the function.
<pattern> by the way, why are the first two types always in parenthesis?
<mrvn> In imperative languages there is usually no way of specifying that.
<phubuh> ('a -> 'b) is the type of a function that takes an 'a and returns a 'b
<mrvn> 'a -> 'b -> 'a list -> 'b list would be a function taking an 'a, a 'b, an 'a list returning a 'b list
<mrvn> let f a b a_list = b_list
<pattern> but aren't the types right binding?
<mrvn> ('a -> 'b) on the otherhand is a function 'a->'b passed as argument.
<phubuh> pattern: now you've entered a pretty confusing area, but don't despair =)
<pattern> so wouldn't it automatically be: ('a -> 'b) -> ('a list) -> ('b list) ?
<phubuh> functions can't actually take several arguments
<pattern> oops, i meant
<pattern> so wouldn't it automatically be: ('a -> 'b) -> ('a list -> 'b list) ?
<phubuh> # let foo a b = a + b;;
<phubuh> val foo : int -> int -> int = <fun>
<phubuh> which actually means val foo : int -> (int -> int)
<phubuh> (foo 1 2) is actually ((foo 1) 2)
<mrvn> pattern: It must be eigther a->(b->(c->d)) or ((a->b)->c)->d
<mrvn> ocaml uses the first
<phubuh> # (foo 1);;
<phubuh> - : int -> int = <fun>
<mrvn> pattern: needs less ()
<pattern> i don't understand why
<phubuh> so, a function that appears to take two arguments is actually a so called curried function, i.e., a function that takes one argument, and returns a function that takes one argument and returns a value
<pattern> but maybe i'll leave this 'till after i understand the typing in the earlier example
<mrvn> ((a->b)->c)->d doesn't work at all for types.
<mrvn> Is that a function taking an (a->b) and a c resulting in a d or a function taking an a, b and c resulting in d?
<mrvn> There is no way to show the difference.
<pattern> hmm
<mrvn> So it must be binding the other way (a->b)->c->d takes a function first a->b->c->d takes an a first
<pattern> i don't understand why (a->b)->c->d is less ambiguous than ((a->b)->c)->d
<pattern> how long did it take you guys to learn ocaml, anyway?
<pattern> am i in for a year-long struggle here? :)
<phubuh> i wouldn't say i "know" ocaml, but i learned what i know in about five days
<pattern> i hate you
<mrvn> pacman`: whats the type of let f a b c = d and let f g c = d (where g is a function a->b)
<phubuh> but i'm quite experienced with scheme and haskell
<pattern> actually, this is my 2nd day
<pattern> so i have 3 more days to catch up :)
<pattern> pacman? are you asking me, mrvn?
<whee> haha
<mrvn> pattern: yes
<pattern> i have no clue
<whee> just think about it, write it on paper if that helps
<pattern> i still don't fully understand even the simple example you were walking me through earlier
<pattern> i have to go back and do the simple example first, guys
<whee> take it one step at a time, revising the types as you figure out more specific requirements
<pattern> don't abuse my tender, virgin brain at so early a date
<mrvn> pattern: The point is that with the wrong binding both functions above would result in the same type but they are clearly different.
<pattern> yes, i understand the importance of correct binding
<mrvn> pattern: You would need extra brackets like [] to denote functions that are parameters.
<pattern> i just don't see the difference between certain bindings, yet
<mrvn> so ocaml just does it the other way around where you dont.
<pattern> i'll just trust you on that :)
<pattern> really, this is way too advanced for me to understand yet
<pattern> let me wrestle with understanding # let compose f g x = f (g x) ;; first
<mrvn> It is realy complex for complexer examples. At university they have a full course just on how you infere the type from an expression.
<phubuh> haha
<pattern> wow
<pattern> that's not good
<mrvn> They study the way ocaml does it and several other algorithms and the benefits and drawbacks of the various methods.
<pattern> it does sound like fun
<mrvn> Its actually quite intresting
<pattern> but i don't relish the thought of having to take a course just to understand one aspect of a language
<phubuh> you don't need to understand it as fully and formally as those guys
<mrvn> pattern: understanding what it outputs is quite different from understanding how it comes to that conclusion.
<pattern> that's true
<pattern> so is there an online resource that goes a bit deeper in to type inference?
<pattern> the ocaml book doesn't seem to go in to it at all
<mrvn> pattern: start "ocaml -rectypes" and try:
<pattern> i'm going to try to sift through this log to extract mrvn's very helpful comments, but it would be nice if i had a little reference telling me the rules ocaml uses to figure out the types of a statement
<mrvn> let loop loop x = if x = 0 then 1 else x * (loop loop (x-1));;
<mrvn> let fac x = loop loop x;;
<mrvn> fac 1;; fac 2;; fac 3;;
<pattern> ok, i did that
<mrvn> Now you have some intresting type to figure out.
<pattern> :)
<mrvn> and some code to understand.
<pattern> challenge accepted
<mrvn> I wonder if I can still create numbers via y combinators.
<pattern> i just started working out the # let compose f g x = f( g x ) ;; example, and i have a question
<pattern> i understand that the left hand side gives you 'a->'b->'c->'d
<pattern> then, you say that the right hand side f(g x) gets typed as (g:'e->'f)
<pattern> why do you start with the (g x) rather than the f ?
<whee> it would have to be evaulated first
<pattern> doesn't the f on the right hand side become 'e ?
<phubuh> (g x) will be evaluated first
<pattern> oh, ok
<whee> same reason 5 * (1 + 2) is 15 and not 7 :)
<pattern> i htought functional languages were independent in their order of evaluation
<phubuh> only languages with no side effects can be
<mrvn> pattern: you can eigther type from outside to the inside or inside to outside and also left to right or right to left.
<whee> a pure lazy functional languagae like haskell is, but ocaml is neither pure nor entirely lazy
<pattern> hmm
<pattern> ok, so i'm going to type from left to right, and from inside to outside
<mrvn> pattern: You have to draw a evaluation tree of the right hand side.
<phubuh> yes, basically
<whee> it's probably easier to understand things if you follow how you think the function would be evaulated
<mrvn> Each node contains the function thats used and the children are the arguments of the function.
<phubuh> oh well, bed time! good luck, pattern
<pattern> i see
<pattern> thanks, phubuh!
<mrvn> Then you can go up or down, left or right in the tree.
<mrvn> ocaml starts at the rightmost leaf and works its way up
<pattern> so f(g x) would be made in to a tree with f as the parent, and g and x as the children
<mrvn> pattern: no (g x) as one child
<mrvn> which is g with child x
<pattern> i see
<pattern> how about the left hand side?
<pattern> compose f g x
<pattern> would that be parent: compose, chlidren f, g, and x ?
<mrvn> yes
<pattern> ok
<mrvn> but it allways is that.
<mrvn> one root and everything else are children
<pattern> you can't have things in parenthesis in the left hand side?
<mrvn> let foo (bla blub) = 1 ?
<mrvn> No, only pattern matchings.
<pattern> ok
<pattern> so, back to the example...
<mrvn> let hd head::tail = head;;
<pattern> why don't i just use 'b for g in f(g x) ?
<mrvn> you do.
<pattern> i thought i used 'e
<mrvn> no g has type 'b, but g must be a function. so 'b = 'e->'f
<pattern> i see
<mrvn> then we compare 'e with the type of x and see that that is 'c, so 'e='c
<pattern> what do you mean by comparing 'e with the type of x?
<pattern> and why would we do that?
<mrvn> x is an argument for g so the type of x must be the same type as the argument g expects
<pattern> the type of x is 'c, which has now become 'f, no?
<mrvn> eigther 'e becomes 'c or 'c becomes 'e
<pattern> but 'b became 'e
<pattern> why would 'e become 'c ?
<mrvn> no, 'b was substitued with 'e->'f
<pattern> ahh
<pattern> so why wouldn't 'c become 'f ?
<mrvn> pattern: 'e and 'c must be the same type. You can use eigther one instead of the other.
<mrvn> 'f is the result of g, which has nothing to do with 'c
<pattern> it doesn't?
<mrvn> no, x is the input for g, not the output of g
<pattern> isn't the type of x 'c, and since 'b became 'e-'f, doesn't x then have to become 'f ?
<pattern> oops, i mean:
<pattern> isn't the type of x 'c, and since 'b became 'e-'f, doesn't 'c then have to become 'f ?
<mrvn> no, 'e
<mrvn> 'f is the return of g and x is the input
<pattern> oh yeah
<pattern> i was getting confused
<pattern> i was thinking that 'f was the argument, but it's the return
<pattern> ok, let me pause and reorganize my view of this
<pattern> ok, now i'm with you
<pattern> x has to be 'e
<pattern> so we have compose: (f:'a)(g:'e->'f)(x:'e)
<pattern> right?
<mrvn> yes
<pattern> so i've done the child of f, on the right hand side
<mrvn> now you can do f
<pattern> now i can go to f, on the right hand side... does that become (f:'g->'h) ?
<mrvn> yes.
<mrvn> must be some function
<pattern> so 'g is 'f ?
<mrvn> yes
<pattern> :)
<pattern> and 'f is 'd ?
<pattern> oops
<pattern> i meant 'h is 'd
<mrvn> yes
<pattern> heh
<mrvn> and then you start renaming them all again so that they appear in ascending order, a b c d ...
<mrvn> thats purely cosmetic for the readers benefit.
<pattern> before i do that, can i say: compose: (f:'f->'d)(g:'e->'f)(x:'e) ?
<mrvn> # let compose (f:'f->'d) (g:'e->'f) (x:'e) = f (g x);;
<mrvn> val compose : ('a -> 'b) -> ('c -> 'a) -> 'c -> 'b = <fun>
<mrvn> works fine.
<pattern> ok... i think i got it
<pattern> now i'm going to do this again from scratch so until i understand it
<pattern> thanks again, mrvn
<pattern> do you teach ocaml in real life?
<mrvn> no, just use it extensively lately.
<pattern> cool
<pattern> well, you're a great help
<pattern> i don't know how i would have understood this on my own
<pattern> there's nothing in the ocaml book about this at all
<pattern> i would have been completely lost
<pattern> i think i might just make a web page out of what you just taught me
<pattern> because there's no reason why this should remain obscure
<mrvn> pattern: As I said, there are university classes about it and more.
<pattern> well, i can't afford the time or money at the moment to go to a university
<pattern> and i'm sure there are other people who'd like to learn ocaml who are in the same boat
<mrvn> Try to type the following:
<mrvn> let y f = ((fun x -> (fun z -> (f (fun y -> (x x) y) z)))
<mrvn> (fun x -> (fun z -> (f (fun y -> (x x) y) z))));;
<pattern> this kind of basic info could really help
<pattern> This expression has type 'a -> 'b but is here used with type 'a
<pattern> it highlights the last 'x' at the end of the top expresion "x) y) z)))"
<mrvn> pattern: you need to use "ocaml -rectypes" for it to work.
<pattern> oh, ok
<mrvn> but you should try it manually to see why.
<pattern> what does that do, anyway?
<pattern> val y : (('a -> 'b) -> 'a -> 'b) -> 'a -> 'b = <fun>
<mrvn> Its the y combinator. Given a function f it results in the fixpoint of f. Thats when F = y F
<mrvn> let nextfac f x = if x <= 1 then 1 else x * (f (x-1));;
<mrvn> let fac = y nextfac;;
<pattern> no, i meant, what does -rectypes do?
<mrvn> It allows for recursive types. Functions that get itself as argument and such.
<pattern> i see
<pattern> ok, i'll try to figure out the y combinator right after i go over compose and make sure i understand it thoroughly
<pattern> bbiab
skylan_ is now known as skylan
Kinners has left #ocaml []
<mrvn> n8
lament has joined #ocaml
<pattern> hey, mrvn, check this out http://aleph.bravepages.com/comp/ocaml/types.txt
foxster has quit [Read error: 104 (Connection reset by peer)]
mattam_ has joined #ocaml
mattam has quit [Read error: 60 (Operation timed out)]
det has quit ["ircII EPIC4-1.1.2 -- Are we there yet?"]
foxster has joined #ocaml
<mellum> Damn. Ocaml doesn't want me to hash abstract values.
docelic is now known as docelic|sleepo
<mellum> Looks like I need custom blocks. Anybody used them before?
<whee> custom blocks?
<mellum> Yes, for extending with C
<mellum> I want to stuff C objetcts into a hash table
<whee> oh, I've done that before
<whee> although I no longer have source :\
<mellum> Hmm, too bad :(
<whee> I figured out how from the ocaml book
<whee> plenty of examples there
<mellum> It wastes a pointer per object... but I don't see a way around it
<mellum> Let me look it up there... thanks
split^ has quit []
lament has quit ["Did you know that God's name is ERIS, and that He is a girl?"]
Yurik_ has joined #ocaml
<Yurik_> re
Yurik_ is now known as Yurik
Yurik has quit [Read error: 104 (Connection reset by peer)]
<mellum> Damn. My Ocaml program segfaults :(
<phubuh> really? you're not compiling with -unsafe, are you?
<mellum> Well, it contains some C code...
<mellum> but that code really looks fine
<phubuh> the debugger is your friend
<mellum> 0x0805a84c in compare_val ()
<mellum> great.
<mellum> I'll try bytecode
<mellum> segfaults, too...
TachYon26 has joined #ocaml
phubuh has quit [Remote closed the connection]
<mellum> Is there something like pow in Ocaml?
<mellum> Ah, **
mrvn_ has joined #ocaml
mrvn has quit [Read error: 60 (Operation timed out)]
smkl has quit [Read error: 60 (Operation timed out)]
docelic|sleepo is now known as docelic
mellum has quit [Read error: 110 (Connection timed out)]
mellum has joined #ocaml
docelic is now known as docelic|away
docelic|away is now known as docelic
mattam_ is now known as mattam
docelic has left #ocaml []
smkl has joined #ocaml
listener has joined #ocaml
<listener> ANyone one using comidl for COM?
listener has left #ocaml []
TachYon76 has joined #ocaml
TachYon26 has quit [Read error: 54 (Connection reset by peer)]
TachYon76 has quit [Read error: 60 (Operation timed out)]
nkoza has joined #ocaml
<mrvn_> Can someone give me an example of a polymorphic method?
mrvn_ is now known as mrvn
systems has joined #ocaml
systems has left #ocaml []
asqui has joined #ocaml
smkl has quit [Read error: 60 (Operation timed out)]
phubuh has joined #ocaml
<phubuh> greetings!
<mrvn> phubuh: Do you have a small example of polymorphic variants?
<mellum> mrvn: sounds scary
<phubuh> i'm afraid i don't
<mrvn> # let f = function `int (i:int) -> "int" | `float (f:float)-> "float";;
<mrvn> val f : [< `float of float | `int of int] -> string = <fun>
<mrvn> # f 1;;
<mrvn> This expression has type int but is here used with type
<mrvn> [< `float of float | `int of int]
<mrvn> Any idea if I can get f defined so that "f 1" with give "int" and "f 1." gives "float?
<mellum> `f 1;;
<mrvn> Thats just a value and not a function
<mellum> Hm, I'm not sure you can do that at all
smkl has joined #ocaml
<mellum> Ah, ask skml, he knows everything :)
<mellum> erm, smkl
phubuh has quit [Read error: 104 (Connection reset by peer)]
phubuh has joined #ocaml
<smkl> polymorphic variants are not used like that. they are like data constructors like Some and None, but typed differently
<smkl> f (`int 1) would return "int"
phubuh has quit [Remote closed the connection]
phubuh has joined #ocaml
<phubuh> ugh, i'm sorry for dropping in and out like this
Yurik has joined #ocaml
<Yurik> re
TachYon has joined #ocaml
<Yurik> TachYon: hi
<TachYon> Hellou Yurik :)
Yurik has quit ["÷ÙÛÅÌ ÉÚ XChat"]
<mrvn> Hmm: zsh: segmentation fault ocaml
<mrvn> # Obj.tag (Obj.repr 1);;
<mrvn> zsh: segmentation fault ocaml
<mrvn> Module Obj isn't for the faint hearted.
<TachYon> scary :)
<phubuh> if I have type a = Foo | Bar and type b = Foo | Bar | Baz, how can I create an a with the value Foo?
<mrvn> type a = Foo | Bar let make_a_foo = Foo type b = Foo | Bar | Baz
<mrvn> or use different Modules/Files
<phubuh> okay :/ thanks
<mrvn> Does anyone know a method to get thetype of something? Does ocamlp4 have a makro for that?
TachYon has quit [Remote closed the connection]
<mellum> Is there something like getopt to parse argv?
<mrvn> yep
<mellum> mrvn: where? I can't find it
<mellum> Ah, got it
det has joined #ocaml
det has quit [Client Quit]
det has joined #ocaml
<det> what is the proper way to compile: $ ocamlopt.opt -o gears gears.ml
<det> File "gears.ml", line 30, characters 2-20:
<det> Unbound value GlDraw.shade_model
<det> ?
<mrvn> you need the gl.cmxa
<mrvn> or labgl.cmxa or something
<det> just add lablgl.cmxa to the command line ?
<smkl> that and -I +lablGL
<mrvn> before gears.ml
<det> I don't have any .cmxa's
<det> just .cmx
<mrvn> smkl: I heard you know everything about ocaml :)
<det> and dlls
<mrvn> smkl: I want to write a function 1 -> "int" | "1." -> "float"
<mrvn> s/"1."/1./
<mrvn> some polymorphic variance hack or something.
<det> mrvn, the windows binary distribution doesnt come with any cmxa's
<smkl> mrvn: not possible with current version of ocaml
<det> oh wait, yes it does
<mrvn> smkl: Is there a way to use ocamlp4 for that?
<mrvn> smkl: I would like to have the type of an argument as string.
<smkl> mrvn: camlp4 is just syntax
<mrvn> So I realy do have to hack the compiler to have a special keywoard type_of(x):'a->string? Too bad.
<smkl> (well you could use Obj module)
<mrvn> I tried. But I can't get the name of type foo = Bar | Baz. Thats just an int at runtime.
<det> blah ..
<det> $ ocamlopt.opt -I /c/tcl/lib -I +labltk labltk.cmxa -I ../lib/lablGL/ lablgl.cm
<det> xa togl.cmxa gears.ml -o gears
<det> GCC.EXE: ../lib/lablGL/togl.a: No such file or directory
<det> GCC.EXE: ../lib/lablGL/lablgl.a: No such file or directory
<det> GCC.EXE: opengl32.lib: No such file or directory
<det> GCC.EXE: glu32.lib: No such file or directory
<det> ..
<det> can ocaml actually compile things to a working state on windows ?
<mrvn> -I +labgl
<mrvn> lablgl evene
<det> mrvn, doesn't come with an .a s
<det> just .lib
<mrvn> then you might have to compile it yourself.
<det> VC6 compiled
<det> seems like half of the binary stuff for windows is mingw and half is msvc
<det> can gcc link .lib files ?
<mrvn> smkl: Any idea on how to debug a brinary compiled prog?
<smkl> mrvn: with printf ...
<det> mrvn, lablg will only compile with msvc which produces .lib :/
<mrvn> I have a program that runs fine as bytecode but throws an exception for Array.get as binary.
<mellum> mrvn: gdb :)
<mrvn> mellum: kein stack zum backtracen, schon versucht
<mellum> mrvn: pech
<det> what does ocamlmklib do ?
<mrvn> pascal ist die Krankheit, die Heilung ist ada :)
<mrvn> ups
ESPINOSA has joined #ocaml
ESPINOSA has left #ocaml []
<phubuh> how do i use labels in interface declarations?
<phubuh> val foo: ~bar:int -> int gives me a syntax error on the ~bar: part
<mrvn> ~bar:int -> int ?
<det> what do I need to link against for:
<det> ml_raw.o(.text+0x1a2b):ml_raw.c: undefined reference to `invalid_argument'
<mrvn> ocaml?
TachYon has joined #ocaml
foxster has quit [Read error: 54 (Connection reset by peer)]
<det> which would typically be called what ? :)
<det> libcamlrun.a didnt work
<det> nor did ocamlrun.a
<det> ocamlrun.dll did the trick, yay
foxster has joined #ocaml
<pattern> mrvn, i am confused in trying to work out the types of the y combinator you gave me as an exercise yesterday... i have the terms numbered for reference here -> http://pastecode.net/index.php?tag=184
<pattern> do i start with the x's that i've numbered 7 and 8, or those that i've numbered 15 and 16 ?
gene9 has joined #ocaml
gene9 has quit [Client Quit]
Smerdyakov has quit [Read error: 54 (Connection reset by peer)]
Riastradh has joined #ocaml
Smerdyakov has joined #ocaml
* Riastradh is confused about how .ml and .mli files and module types and modules and all that sort of thing go together.
<Riastradh> In point.mli, I declare the module type POINT to have a signature that declares a class with several methods.
<Riastradh> In point.ml, I define the module 'Point' to have a type of 'POINT' and define the class and such.
<Riastradh> Yet ocamlc and ocamlopt complain when I do: ocaml(c|opt) -c point.mli; ocaml(c|opt) -c point.ml
systems has joined #ocaml
<Riastradh> Specifically, they state that, when doing 'ocaml(c|opt) -c point.ml' (after compiling point.mli): The implementation point.ml does not match the interface point.cmi: The field `POINT' is required but not provided
<Riastradh> Oops, no, that was a previous error message.
<Riastradh> It instead complains: Unbound module type POINT
<whee> I think what you're doing is creating the module Point.Point and not Point as you are expecting
<whee> each file gets its own module name automatically
<Riastradh> What, then, should I do?
<Riastradh> Use 'module Point : Point.POINT'?
<whee> just don't start by definining the Point modue, start with the class
<whee> or whatever
<Riastradh> And leave the module type POINT in point.mli as it is?
<whee> no, get rid of that too
<Riastradh> Ah, it works now.
<Riastradh> But how, then, should I ever need to, should I declare a module type and define a module?
<Riastradh> i.e., to use functors.
<pattern> is there much of a difference between ocaml and caml light? i'm considering checking out the caml light tutorial to get more insight in to ocaml... would that be wise?
<phubuh> what's the easiest way to get some sort of string containing only letters and/or number that correspond directly to the string?
<phubuh> one thing that fits the description would be a simple hex encode
<whee> there's quite a bit of new things pattern
<whee> I wouldn't recommend doing that :)
<whee> well, maybe it'd be good to look at it, but don't expect things to be exactly the same
<pattern> too bad... there don't seem to be all that many english-language ocaml tutorials/books
<whee> Riastradh: if you use functors you would have to do what you were doing previously
<pattern> especially compared to, say, c
<Riastradh> whee - And thus use something like 'Point.Point.point' to get the class?
<whee> Riastradh: gimme a sec, I'll find out :)
<whee> I'd try looking for something that utilizes the Map or Set modules in stdlib; those are bboth functors
<phubuh> how do i get the hexadecimal representation of an integer?
<whee> phubuh: for use how?
<mattam> use python :)
<whee> mattam: not needed :P
* Riastradh throttles mattam for suggesting such blasphemy.
<whee> phubuh: the Printf module supports output in hex, binary, maybe octal
<mattam> well hex() is really nice you know
<phubuh> whee: turning an md5 digest into readable ascii
<phubuh> ah, of course, thanks!
<Riastradh> Printf.printf's '%x' format gizmo turns it into hex.
<Riastradh> %o to octal...
<whee> you could use sprintf if you'd like a string instead of output to a channel
<whee> or bprintf for a buffer output
<phubuh> yeah
<whee> then of course there's scanf for going the other way around
<Riastradh> ...and it doesn't look like there's one for binary.
<Riastradh> That sucks.
<whee> Riastradh: there is
<whee> in CVS, at least
<Riastradh> What is it?
<whee> %b
<Riastradh> No, that's boolean; it prints 'true' or 'false.'
<whee> no, that's %B
<Riastradh> Maybe I have an old version of OCaml.
<whee> it might not be in 3.06
<whee> this is how it is in CVS
<phubuh> can match patterns do like x :: xs, except c ^ cs, where c stands for character, and ^ is our beloved concatenation operator
<whee> phubuh: no
<phubuh> =/
<whee> yes, strings are a pain to work with sometimes :)
<phubuh> that would be great
* Riastradh downloads the CVS version.
<whee> you could probably add it easily with camlp4, converting that into a guard
<phubuh> camlp4?
<whee> the preprocessor
<phubuh> i get the feeling i've been missing something great
<phubuh> oh my god
<whee> heh
<whee> camlp4 isn't a crappy preprocessor like c's, it can directly generate asts :)
<Riastradh> cpp sucks; it's simple text replacement.
<Riastradh> Camlp4, from what I've seen, is like LISP macros except a lot harder to use because of ML's lack of a simple syntax like LISP.
<phubuh> heh
<whee> it's hard to get a handle on the stream based parsing, but it's easy to work with after that
<Riastradh> Er, no, more like Scheme's macros.
<whee> it's worth learning if you have a chance
<whee> since you can use stream based parsing in ocaml itself, which is pretty nice
<whee> you can do a lot of neat things with streams in general
det has quit [Remote closed the connection]