gl 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 | http://icfpcontest.org/ !!
GreyLensman has joined #ocaml
* Demitar adds a big warning sign on pycaml.
<awwaiid> what does the sign say?
<wolfman8k> this is way OT but it's awesome: http://www.detoursvideo.com/kolla2003.wmv
<Nutssh> Whats pycaml?
<Demitar> awwaiid, I was able to get a segfault, but that might have been just that one function I called.
<Demitar> Nutssh, python interface from ocaml.
<Nutssh> Oh. Heh.
<Nutssh> There should be an implementation of python on ocaml. :)
<Demitar> IIRC there is an implemenation of python in ocaml floating around.
<Demitar> Btw, good FFI to perl and python is a *good* thing.
wolfman8k is now known as wolf|Zzz
mrsolo_ has quit [Read error: 60 (Operation timed out)]
Nutssh has quit ["Client exiting"]
bk_ has joined #ocaml
segphault has left #ocaml []
awwaiid has quit [Connection timed out]
bk_ has quit ["Leaving IRC - dircproxy 1.1.0"]
mrsolo_ has joined #ocaml
urz has joined #ocaml
<urz> hello
<urz> strong typing has caused a bit of strangeness here. This code seems repititious and silly:
<urz> try
<urz> let msgs = Hashtbl.find cm cmd in
<urz> Hashtbl.replace cm (msg :: msges)
<urz> with Not_found ->
<urz> Hashtbl.add cm [msg]
<urz> try
<urz> let cmds = Hashtbl.find mc msg in
<urz> Hashtbl.replace mc (cmd :: cmds)
<urz> with Not_found ->
<urz> Hashtbl.add mc [cmd]
<urz> two hashtables that map from some type to a list of some type
<urz> what is a more elegant way to code that sequence?
<karryall> let f t k = let l = try Hashtbl.find t k with Not_found -> [] in Hashtbl.replace t k (v :: l) in f cm cmd msg ; f mc msg cmd ;;
<karryall> forgot an arg: let f tk v = ...
<karryall> rahh let f t k v = ...
<urz> heh
<urz> thats not doable is it?
<urz> mc and cm have different types
<karryall> of course it is !
<karryall> that's the whole point if having parametrized types and polymorphic functions
<karryall> s/if/of
<karryall> f has type
<karryall> ('a, 'b list) Hashtbl.t -> 'a -> 'b -> unit
<urz> i see
<urz> and it keeps that type even when we apply it later
<karryall> yes
<urz> my rewrite:
<urz> let remove_from_list table key value =
<urz> try
<urz> let values = Hashtbl.find table key in
<urz> Hashtbl.replace table (value :: values)
<urz> with Not_found ->
<urz> Hashtbl.add table [value]
<urz> in
<urz> remove_from_list cm cmd msg;
<urz> remove_from_list mc msg cmd
<urz> oh remove, heh
<urz> wrong function
<urz> this is adding
<urz> changed the name, heh
cjohnson has quit [Read error: 104 (Connection reset by peer)]
Lemmih has quit [Remote closed the connection]
Smerdyakov has quit ["sleep"]
<urz> hey
<urz> if i want to store various different kinds of lists in a single hash, how do i do that?
<karryall> you'd have to build a variant type
<karryall> type my_data = Int of int | Float of float ...
<urz> ug
<karryall> or you just don't store various different kinds of lists in a single hash :)
<urz> well, theres only one type in a list
<karryall> well then type my_data = Intlist of int list | Floatlist of float list ...
<urz> i see
<urz> but i want the data structure to know its a a list type
<urz> what you suggest will make it so that theres no way to treat it as a list unless i know what its a list of
<urz> unless it makes sense to match against _ (x :: rest) where _ stands for some constructor symbol
<karryall> ah, no it does not make sense
<urz> so this is a pretty pickle of a problem
<urz> unless i want to just alow multiple types in a single list
<karryall> that does not necessarily mean multiple types in a single list, just that the type checker cannot prove fot you anymore
<urz> yeah
<karryall> you'll have to be careful
<karryall> but I would seriously consider using several hashes
<karryall> bbl
ne1 has joined #ocaml
GreyLensman has quit ["mutable state is the egg from which all bugs pupate."]
sundeep has quit [Connection timed out]
sundeep has joined #ocaml
ne1 has quit ["To understand recursion, you must first understand recursion."]
AnvilVapre has joined #ocaml
vezenchio has quit ["look at you, hacker, a pathetic creature of meat and bone, panting and sweating as you run through my corridors; how can you ]
<urz> hi
<urz> what does 'c. mean?
<urz> with the dot? in a type expression?
<urz> i dont understand the dots
<vegai> give me an example
<vegai> me/us
<urz> sigh
<urz> i'll give you my error message
<urz> This expression has type
<urz> < add_callback : ('a -> unit) -> unit; complete : 'b;
<urz> get_watch_fors : string list;
<urz> handle : conn_t -> string option -> Irc.msg -> unit; .. >
<urz> but is here used with type
<urz> cmd_callbacks_interface =
<urz> < add_callback : 'c. ('c -> unit) -> unit; complete : unit;
<urz> get_watch_fors : string list;
<urz> handle : conn_t -> string option -> Irc.msg -> unit >
<urz> Self type cannot be unified with a closed object type
<urz> lord help me
mrsolo_ has quit [Read error: 54 (Connection reset by peer)]
mrsolo_ has joined #ocaml
kosmikus|away is now known as kosmikus
<urz> hi
<urz> in most OO languages, i can make a list of parent class refrences that actually refer to child class objects
<urz> how do i do this with ocaml?
<karryall> a method with a 'c. is a polymorphic method. it means "for all types 'c, ..."
<karryall> practically this means you have to add a type annotation somewhere
<karryall> as for your second question, if you're referring to downcasting, that's not possible in ocaml
<urz> i see
<urz> waht do i do with this now?
<urz> This expression has type
<urz> < add_callback : ('a -> unit) -> unit; complete : 'b;
<urz> get_watch_fors : string list;
<urz> handle : conn_t -> string option -> Irc.msg -> unit; .. >
<urz> but is here used with type
<urz> 'a cmd_callbacks_t =
<urz> < add_callback : ('a -> unit) -> unit; complete : unit;
<urz> get_watch_fors : string list;
<urz> handle : conn_t -> string option -> Irc.msg -> unit >
<urz> Self type cannot be unified with a closed object type
<urz> in particular, what do they mean Self cannot be unified with closed object type?
<karryall> self is the type of the class being defined. While it's not completely defined there are certain things you cannot do with it
<karryall> seeing a bit more code would help
<urz> well, i want a member function to add self into a hash, but i declare the hash before i declare the class for a few reasons
<urz> so i try to provide a prototype with a "class type" declaration
<urz> maybe that was a bad solution
<karryall> no, a priori it's a good solution
<urz> well this shouldnt be so complicated
<urz> so i cant invoke a function on self unless its a member function?
ejt has joined #ocaml
<urz> say i want: let a#add_yourself hash = Hashtbl.add hash self
<urz> heh
<urz> or better,
<urz> let a#add_yourself hash = Hashtbl.add hash a
<urz> is that legal?
<karryall> syntactically, no
_fab has joined #ocaml
<urz> well how do i do it syntactically?
<karryall> and Hashtbl.add takes 3 arguments, you really want a partial application here ?
<urz> oh
<urz> yeah well put a 1 on the end
<urz> good?
<urz> how is this done?
<urz> it seems a simple thing to want to do
<urz> hm
<karryall> well yes it's possible: method add_yourself hash = Hashtbl.add hash self 1
<urz> actually i want something like this:
<urz> method add_yourself = Hashtbl.add member_variable_hash self 1
<urz> where member_variable_hash is passed with new at object creation time
<urz> but the type of member_variable_hash is parameterized on the class type so its problematic
<urz> do i have to declare all member functions in one place?
<karryall> do you really need the class type ?
<karryall> because something like this should work:
<karryall> class ['a] baz (i : 'a) = object (self) val v = i method get_v = v method add hash = Hashtbl.add hash v self end
<urz> is it also impossible to up cast self?
<urz> i tried to pass super to my hash, heh
mr_bungle has joined #ocaml
<urz> i want the hash to be part of the object
<urz> i mean
<urz> i want the object to know the hash
<urz> so the caller doesnt have to
<urz> so i have to pass a pair around now? (hash, obj) ?
<urz> this seems silly
<urz> im getting disgusted
<urz> hello
<urz> i have a new unrelated question
<Banana> yes ?
<urz> Is it okay to modify the hashtable within an iteration of Hashtbl.iter ?
<urz> i want to delete the item i just visited
<urz> from the table
<Banana> i think it's ok...
<urz> do i have to make a list of items to delete first and iterate over that?
<Banana> iter is guarantied to see exactly each element once.
<Banana> so it should be fine.
<urz> i have doubts
<urz> what if i was adding elements?
<Banana> ?
<urz> it'd repeat for ever
<urz> maybe
<Banana> how do you add elements while itering ?
<karryall> urz: no I don't think that's a good idea
<Demitar> urz, are you really sure you need to downcast your classes?
<Demitar> s/classes/objects/
Anvil_Vapre has quit [Read error: 60 (Operation timed out)]
<urz> nevermind, i've given up on that and worked around it
<urz> i now want a template function like in c++, heh. It creates a new object but the class of the object is a parameter
<urz> how do i do that?
<Demitar> When would you use that exactly?
<urz> well im using it as a macro basically
<urz> is it not possible?
<karryall> urz: probably not
<Demitar> But won't the typing differences make it practically unuseful.
<urz> oh
<urz> unuseful how? it would have saved typing
<Demitar> But where would it save you typing from doing new foo rather than new<foo>?
<Demitar> (You can of course use any preprocessor you want to do macros.)
<urz> well it did more than that
<urz> thats just the problematic part i mentioned
<Demitar> Add yourself to a hash for downcasting?
<urz> let cmd =
<urz> try Hashtbl.find hash msg
<urz> with Not_found -> new <need class here> msg
<urz> in
Anvil_Vapre has joined #ocaml
<karryall> you don't need macros for that, new <a class> is valid functional value
<karryall> let cmd obj_constructor = try Hashtbl.find hash msg with Not_found -> obj_constructor msg in ...
<Demitar> Otherwise it couldn't be properly polymorphic anyway, or?
<urz> and i have to do a (fun x -> new blah msg) when invoke the macro?
<urz> er
<urz> well i'd have to use fun ?
<Demitar> urz, you can make a function for each class let blah_ctor = new blah
<karryall> (new blah) should be enough
<urz> oh
<Demitar> karryall, ah, right. It's a function returning a class..
<urz> nice, okay
<karryall> yep
<Demitar> urz, well in essence the difference would be (cmd<blah> msg) vs (cmd (new blah) msg)
lam has quit ["leaving"]
lam has joined #ocaml
<urz> um
<urz> does upcasting need to be explicit?
<Demitar> Or? :)
<urz> im getting an error message
<Demitar> Yes.
* Demitar personally prefers using modules rather than classes.
<urz> heh, now i still have the problem that i need to pass a type in order to do the explicit upcast
<urz> let cmd =
<urz> try Hashtbl.find hash msg
<urz> with Not_found -> new <need class here> msg
<urz> in
<Demitar> I think you're doing too much evil stuff. :)
<urz> er
<urz> thats the wrong paste
<urz> sorry
<Demitar> I get the suspicion you're using the wrong tool to archieve whatever you are aiming for.
<Demitar> Why do you need classes?
<Demitar> Anything a function with a closure won't handle?
<urz> i wanted to use inheritence
<urz> you'd never use classes for anything, am i right?
<urz> this is the first time i've toyed with them in ocaml
<Demitar> I would were it the right tool.
<Demitar> Most of the time it's not though.
<Demitar> My main reason to use classes would actually be syntactic sugar. :)
<Demitar> obj#func rather than Module.func obj
<urz> heh
<Demitar> But in the end I think the latter has many advantages over using classes.
<urz> okay
<urz> well
<Demitar> (Better type inference being a big one.)
<urz> i didnt think i was doing something that would be hard to implement with classes
<urz> i started with non classes and then decided to do the class way on a whim
<urz> and it put me in ocaml hell
<urz> might as well take the o off of ocaml, man
<urz> heh
<Demitar> Well the thing is that classes in ocaml are by structure and not by name, that's the thing you want to leverage rather than the hierarchy you want to leverage in the case of c++/java/...
<urz> lets look at my object
<urz> of the parent class
<karryall> Demitar: heh, I did a syntax extension once that did this kind of syntactic sugar
<urz> i have a list of callback functions each of type 'a -> unit
<urz> i had a variable result that is of type 'a
<urz> then i had a method get_watch_fors that would return a list of strings representing events that this object is interested in.
<urz> that is actually fixed for each subclass
<urz> then it had a method handle which handles one of those events manipulating is result variable and possibly invoking the method complete which calls all the callbacks in the list with the value of result
<Demitar> Is it perhaps so that you actually want a set rather than a class hierarchy?
<urz> yeah
<urz> the heirarchy would be one level deep
<urz> all from a single root
<Demitar> That's very frequently the case. :)
<urz> so lets Modulify this design
<urz> heh
<urz> i'll scrap the classes
<urz> unless you think that ill advised?
<urz> hm
<Demitar> I'm no guru. I merely hack OCaml but it sounds like all you need is a list of tuples or a number of functions returning tuples or whatever.
<urz> the 'a parameter would depend on the subclass by the way
<urz> so i was actually having a bunch of roots
<urz> but not because i wanted too really
<urz> hmm
<urz> module Handler =
<urz> struct
<urz> type t = {
<urz> mutable callback_list : 'a list;
<urz> }
<urz> end
<urz> i've not done parameterized modules
<karryall> type 'a t = ...
<Demitar> How are the different callbacks used since they have type 'a?
<urz> well i said 'a but i should have said 'a -> unit
<Demitar> Still, you can only have one of those in any one place.
<Demitar> one type that is.
<urz> well the entire module is going to use a single type for 'a
<Demitar> Anyway, I'm off to eat lunch. Later.
kosmikus is now known as kosmikus|away
Iter has joined #ocaml
wolf|Zzz is now known as wolfman8k
buggs^z has joined #ocaml
buggs has quit [Read error: 110 (Connection timed out)]
cedricshock has joined #ocaml
buggs^z is now known as buggs
mr_bungle has quit [Remote closed the connection]
Iter has quit [calvino.freenode.net irc.freenode.net]
_shawn has quit [calvino.freenode.net irc.freenode.net]
Iter has joined #ocaml
_shawn has joined #ocaml
segphault has joined #ocaml
segphault has quit [Client Quit]
Lemmih has joined #ocaml
urz has quit ["[BX] For a good time, call 1-900-4BitchX"]
noss has joined #ocaml
Iter has quit [Read error: 110 (Connection timed out)]
Nutssh has joined #ocaml
Nutssh has left #ocaml []
maihem has joined #ocaml
Hipo has quit [Read error: 54 (Connection reset by peer)]
Hipo has joined #ocaml
bk_ has joined #ocaml
mattam_ has joined #ocaml
mattam has quit [Read error: 110 (Connection timed out)]
wolfman8k has quit [Read error: 60 (Operation timed out)]
wolfman8k has joined #ocaml
Hipo has quit [Connection timed out]
Hipo has joined #ocaml
Submarine has joined #ocaml
Anvil_Vapre has quit ["Leaving"]
maihem has quit ["Read error: 54 (Connection reset by chocolate)"]
mattam_ is now known as mattam
mrsolo_ has quit [Read error: 60 (Operation timed out)]
noss has quit ["Leaving"]
koa has joined #ocaml
wolfman8k has quit ["Leaving"]
blop_ronan has joined #ocaml
blop_ronan has quit ["L'enfer, c'est les autres."]
p0lartype has quit ["Client Exiting"]
CosmicRay has joined #ocaml
koa has left #ocaml []
truls has joined #ocaml
<truls> hi folks
<Submarine> hi
monotonom has joined #ocaml
_shawn has quit [calvino.freenode.net irc.freenode.net]
Smerdyakov has joined #ocaml
_shawn has joined #ocaml
Smerdyakov has quit ["eat"]
mrsolo_ has joined #ocaml
CosmicRay has quit ["Client exiting"]
monotonom has quit ["Don't talk to those who talk to themselves."]
Submarine has left #ocaml []
Iter has joined #ocaml
Nutssh has joined #ocaml
kosmikus|away is now known as kosmikus