flux__ changed the topic of #ocaml to: OCaml 3.09.2 available! Archive of Caml Weekly News: http://sardes.inrialpes.fr/~aschmitt/cwn/ | A free book: http://cristal.inria.fr/~remy/cours/appsem/ | Mailing List: http://caml.inria.fr/bin/wilma/caml-list/ | Cookbook: http://pleac.sourceforge.net/
mikeX has quit [Remote closed the connection]
smimou has quit ["bli"]
shawn has quit ["This computer has gone to sleep"]
khaladan has quit [Read error: 104 (Connection reset by peer)]
bmp has joined #ocaml
hikozaemon has joined #ocaml
chessguy has joined #ocaml
shawn has joined #ocaml
shawn has quit ["This computer has gone to sleep"]
Smerdyakov has quit ["Leaving"]
AI_coder has joined #ocaml
<jer> anybody know of any (active, or at least semi-complete) cocoa/carbon bindings?
<jer> or hell, any gui toolkit that works on osx w/o x11
chessguy has quit [" HydraIRC -> http://www.hydrairc.com <- 100,000+ downloads can't be wrong"]
jcreigh has joined #ocaml
AI_coder has quit [Read error: 104 (Connection reset by peer)]
<szlo> jer: been looking for one, and just found projects that were abandoned in a very early stage.
<jer> yeah ditto
<szlo> What you want is a portable GUI that can work *also* on MacOSX without X11 right? (as opposed to a GUI that just runs on macosx)
<jer> that would be nice, but not required
<szlo> The former is hard to come by. For the second, an ocaml-objc bridge would do. Not very elegantly though
<jer> yeah i'm not too familiar with ocaml internals to be writing a bridge; and it's not something i'd want to do as a first non-trivial task =]
<szlo> Ideally, it would enable the use of interface builder and bind to the nib file. The task would be quite hard in pure ocaml (see the gnustep project and gorm), which is why a bridge makes sense.
<jer> nod, i'm very much familiar with gnustep and gorm
jcreigh has quit ["Do androids dream of electric sheep?"]
shawn has joined #ocaml
shawn has quit [Connection reset by peer]
shawn has joined #ocaml
_jol_ has joined #ocaml
shawn has quit ["This computer has gone to sleep"]
love-pingoo has joined #ocaml
_jol_ has quit [Read error: 110 (Connection timed out)]
love-pingoo has quit [Read error: 104 (Connection reset by peer)]
shawn has joined #ocaml
smimou has joined #ocaml
Schmurtz has quit [Read error: 110 (Connection timed out)]
pango is now known as pangoafk
love-pingoo has joined #ocaml
pangoafk is now known as pango
_jol_ has joined #ocaml
_fab has joined #ocaml
Revision17 has joined #ocaml
ski has quit [Read error: 110 (Connection timed out)]
ski has joined #ocaml
revision17_ has quit [Read error: 110 (Connection timed out)]
_jol_ has quit ["leaving"]
ski has quit [Read error: 110 (Connection timed out)]
ski has joined #ocaml
slipstream has joined #ocaml
slipstream-- has quit [Read error: 110 (Connection timed out)]
_jol_ has joined #ocaml
Smerdyakov has joined #ocaml
andreas_1 has joined #ocaml
<andreas_1> hi
<love-pingoo> hi
<andreas_1> I am trying to install the "extlib" library via ocamlfind, however "ocamlfind install extlib" gives me an error
<andreas_1> ocamlfind: The META file is missing
<andreas_1> Does anybody know where I can get that METAFILE? THX
<love-pingoo> isn't it generated at configure ?
<love-pingoo> that's weird
<andreas_1> well, I am on a mac and compiled findlib from source
<andreas_1> Maybe I am mistaken about the findlib in general? Findlib is some sort of package management tool for ocaml, right?
<love-pingoo> extlib should provide its META file
<love-pingoo> I don't use it, sorry.
<andreas_1> so the METAFILE should be distributet together with the extlib sources?
<love-pingoo> or generated during the building of it
<love-pingoo> you can try writing it yourself
<love-pingoo> (I'll show you one example in private)
<andreas_1> private ???
<love-pingoo> query
<love-pingoo> dialog
<love-pingoo> didn't you see it ?
<andreas_1> no, sorry
<love-pingoo> <love-pingoo> name="dtools"
<love-pingoo> <love-pingoo> version="0.1.1"
<love-pingoo> <love-pingoo> description="OCaml deamon tools library"
<love-pingoo> <love-pingoo> requires="str unix threads"
<love-pingoo> <love-pingoo> archive(byte) = "dtools.cma"
<love-pingoo> <love-pingoo> archive(native) = "dtools.cmxa"
<love-pingoo> <love-pingoo> writing extlib's META might not be that hard (if you can figure out the requirements of it)
<love-pingoo> <love-pingoo> if you don't put the requirements, the "ocamlfind ocamlc" compiler won't implicitely add them at compilation/linking
<love-pingoo> sorry guys for the flood
<Smerdyakov> You are under arrest.
<andreas_1> thx, I will try
ski has quit [Connection timed out]
ski has joined #ocaml
mikeX has joined #ocaml
ski has quit [Connection timed out]
ski has joined #ocaml
Smerdyakov has quit ["Leaving"]
andreas_1 has quit []
andreas_1 has joined #ocaml
Schmurtz has joined #ocaml
_jol_ has quit ["co'o rodo"]
mikeX has quit ["later"]
hikozaemon has quit ["Leaving..."]
andreas_1 has quit []
Bigb[a]ng is now known as Bigbang
andreas_1 has joined #ocaml
<flux__> let's say I have let foo a b c = a (b c)
<flux__> it has type val foo : ('a -> 'b) -> ('c -> 'a) -> 'c -> 'b
<flux__> then let's say I write function let bar a ?(b=fun a -> a) c = a (b c), which should be the same, except it has a labeled second argument, with a default value
<flux__> it has type val bar : ('a -> 'b) -> ?b:('a -> 'a) -> 'a -> 'b
<flux__> how should I write that function so I its type would be val bar : ('a -> 'b) -> ?b:('c -> 'a) -> 'c -> 'b ?
<flux__> I already have an .mli-file, but my function doesn't match the declared type..
<flux__> (I wonder if that's actually a bug)
<pango> # let bar a ?(b=fun x -> failwith "missing argument") c = a (b c) ;;
<pango> val bar : ('a -> 'b) -> ?b:('c -> 'a) -> 'c -> 'b = <fun>
<flux__> well, that's not what I want :)
<flux__> I would just use ~b in that case :)
<pango> b must have the same type as its default value
<flux__> well, fun () -> () is a special case of 'a -> 'b..
<flux__> uh
<flux__> fun a -> a I mean
<flux__> another approach ocaml could take would be, for optional arguments, to expect as general type as possible
<flux__> would it be much more difficult to implement?
<pango> I think it wouldn't type
<flux__> hm
<flux__> well obviously bar ~b:identity is correctly typed program, no?
<flux__> yet it could be something non-identity too, a function where 'a differs from 'b
<pango> it's way too hot here to answer ;)
<flux__> happily it's 11.5 degrees celcius here
<flux__> "happily"
<flux__> and 5.0 m/s wind from the north
<flux__> that's finnish summer for you ;)
<pango> I think it comes from the fact that optional argument is converted to
<pango> # let bar a b c =
<pango> a ((match b with None -> fun a -> a | Some b -> b) c) ;;
<flux__> yeah, I figured that I cannot rewrite the function with that approach
<flux__> but, it's too bad that _that_ itself cannot be type to be 'a -> 'b?
<flux__> typeD
<flux__> hmm.. obj.magic.. ;-)
<flux__> muahahaha ;-)
love-pingoo has quit ["Leaving"]
<pango> b and fun a -> a have the same input types, and the same output types; and since fun a -> a has the same output type as its input type, so does b
<pango> I wonder too, if there's a way around that...
<flux__> hmph
<flux__> I was hoping this would work, but it doesn't: let f (a:'a->unit) ?(b=(Obj.magic (fun a -> a) : 'a -> 'b)) (c:'b) = a (b c)
<flux__> hm, maybe precedency
<flux__> nope
<flux__> I suppose this kind of problem only occurs with optional types
<flux__> s/types/arguments/
<flux__> with default values
<flux__> I suppose I could just write any kind of function and finally Obj.magic it in..
<flux__> maybe I shouldn't
<flux__> I don't know enough about the dirty details to do that ;)
Smerdyakov has joined #ocaml
<flux__> cool! let f : ('a -> unit) -> ?b : ('b -> 'a) -> 'b -> unit = fun a ?(b=((Obj.magic (fun a -> a)) : 'b -> 'a)) c -> a (b c)
<flux__> f (Printf.printf "%s\n") "42";;
<flux__> f (Printf.printf "%d\n") ~b:int_of_string "42";;
<flux__> and that type definition at Obj.magic is useless
<flux__> I wonder, though, if I want to use that.. atleast I would like to put big warnings around it :)
<pango> # f (Printf.printf "%d\n") "42" ;;
<pango> 67347000
<pango> probably a good idea ;)
<pango> # f (Printf.printf "%s\n") 42 ;;
<pango> Segmentation fault
<dylan> O.o
<flux__> hmm.. right.. I didn't think that through :)
<flux__> the strictness is required, so I guess it is unavoidable to force the caller to give that identity-function too
<flux__> here's the type for reference: val f : ('a -> unit) -> ?b:('b -> 'a) -> 'b -> unit = <fun>
<flux__> so I can give it an argument where b is fun a -> a, but it cannot be the default argument :/
<dylan> You couldn't even curry it like that.
<flux__> the default argument's value should somehow be embedded into the calling code
<flux__> but it won't be, because the interface won't reveal it, which OTOH is nice
<flux__> I want a more powerful type system ;)
<flux__> haskell doesn't have optional arguments, so I guess it doen't have this problem.. or has someone emulated them with type classes?-o
<dylan> Able to leap tall problems in a single bound?
<flux__> I suppose the sml 'workaround' for not having optional arguments has the same problem
<flux__> and haskell too
<flux__> I wonder if there's a better workaround though. but it won't be so easy to write, I'm sure..
<Smerdyakov> I wasn't here from the start. What are you trying to do?
<flux__> function f : ('a -> unit) -> ?b : ('b -> 'a) -> 'b -> unit with default argument b=identity
<Smerdyakov> Why not just make two functions, one with fewer arguments which calls the first?
<flux__> well, that's one option ;)
<dylan> # let bar a b c = foo a (match b with Some b' -> b' | None -> (fun x -> x)) c ;;
<dylan> val bar : ('a -> 'b) -> ('a -> 'a) option -> 'a -> 'b = <fun>
<Smerdyakov> flux__, seriously, is there any practical advantage whatsoever to doing it with optional arguments?
<flux__> well, I was extending an old function, and there might not be any more meaningful name for the 'new' function, I suppose I could just call it f'
<dylan> the problem is not that it is an optional argument.
<dylan> the problem is it can't be properly typed by ocaml.
<flux__> and I obviously wouldn't want to modify the old code (this is academical, because there's only a few files)
<Smerdyakov> That depends on the functionality.
<Smerdyakov> Something like foo for the identity-fixed version and fooMap for the other.
<flux__> if I later wanted to extend the function in a similar fashion, I would need f''
<flux__> but maybe then I would have a too large function anyway
<Smerdyakov> Obviously using primes is inane.
<dylan> wow, this is some awesome lag.
<dylan> let don't_panic = true
<Smerdyakov> Perhaps take a lesson from the Array.foo and Array.fooi functions, where the *i versions have take arguments with extra arguments.
jcreigh has joined #ocaml
<dylan> I have a feeling my ISP is doing nasty QoS to my ssh connection...
Schmurtz has quit ["Dodo !"]
Schmurtz has joined #ocaml
jcreigh has quit [Connection timed out]
love-pingoo has joined #ocaml
pango is now known as pangoafk
andreas_1 has quit []
jcreigh has joined #ocaml
finelemon has joined #ocaml
pangoafk is now known as pango
finelemo1 has quit [Read error: 104 (Connection reset by peer)]
finelemo1 has joined #ocaml
finelemon has quit [Read error: 110 (Connection timed out)]
khaladan has joined #ocaml
jcreigh has quit ["Do androids dream of electric sheep?"]
chessguy has joined #ocaml
revision17_ has joined #ocaml
bmp has left #ocaml []
Revision17 has quit [Success]
_JusSx_ has joined #ocaml
_JusSx_ has quit ["leaving"]
Bigbang is now known as Bigb[a]ng
shawn has quit [Connection timed out]
shawn has joined #ocaml
_shawn has joined #ocaml
_fab has quit []
shawn has quit [Connection timed out]
shawn has joined #ocaml
_shawn has quit [Connection timed out]
_shawn has joined #ocaml
love-pingoo has quit ["Connection reset by by pear"]
vincenz has quit ["leaving"]
vincenz has joined #ocaml
shawn has quit [Connection timed out]
shawn has joined #ocaml
BlueBlazer has joined #ocaml
_shawn has quit [Connection timed out]
_shawn has joined #ocaml
smimou has quit ["bli"]
_shawn has quit [Connection timed out]
_shawn has joined #ocaml
mikeX has joined #ocaml
rillig has joined #ocaml