systems 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 | Caml Weekly news http://pauillac.inria.fr/~aschmitt/cwn/
<thomas001> enum.cc:3: invalid conversion from `int' to `foo'
<det> also
<thomas001> det: in C++ there is no implicit int -> enum
<det> switch has all kind of caveat that you can't get with match
<det> oh :)
<det> I forget c++ likes to pretend it is type-safe
<lus|wazze> oh we're talking about c++ - ok thats something different
<lus|wazze> still you can explicitly cast an int to an enum
<lus|wazze> with the same results
<Riastradh> (0 : foo) won't work.
<det> my main point was dispatching on the variant/ enum anyways
<lus|wazze> but the most important limitation of enums is that the constructors cant have arguments
mattam has quit [Read error: 60 (Operation timed out)]
<lus|wazze> in enums
<lus|wazze> eg like type foo = A of int | B of float | C of string
<lus|wazze> and consequently you can't use anything like the powerful pattern-matching constructs of ocaml on them
<det> ocaml will make sure you always match it correctly (cant leave of one of the enums, etc)
<det> s/of/off/
<thomas001> when doing type foo=A|B|C;; are A,B,C globally defined symbols?
<Riastradh> They're defined in the current module; there is nothing that's 'global,' as far as I know, in OCaml.
<det> lus|wazze: yeah, you need to use union's to achieve that sort of thing, which are most definately NOT type-safe :)
<thomas001> template<class T> class Enum{public:bool operator==(const Enum<T>& e){return this==&e;}}; class foo:public Enum<foo>{} A,B,C; <-- typesafe enums in C++ ?
* Riastradh barfs.
<Riastradh> BURN THE HERETIC!
<Riastradh> C++ code in #ocaml! Stop the presses! Get the stakes!
<Riastradh> C++ template code, that is.
<thomas001> sure it is ;)
<det> thomas001: you still can't properly match the enum
<thomas001> det: what do you mean with match?
<det> thomas001: you need to be able to say, in a type-safe manner, do this for A, this for B and this for C
<thomas001> if(e==A){}else if(e==B){}else if(e==C){}else throw BadEnum();
<thomas001> not nice,but switch does not work with objects
<det> that leaves the possibility of forgetting an enum
mattam_ has quit [Read error: 54 (Connection reset by peer)]
<thomas001> yes
<det> type foo = A | B | C
<det> let print_foo f =
<det> match f with
<det> A -> print_string "A"
<det> | B -> print_string "B"
<det> | C -> print_string "C"
* Riastradh hides before the equivalent C++ code is pasted.
<thomas001> det: yes it's nicer in ocaml
<det> you are guarenteed to cover all cases exactly once in ocaml :)
<det> not to mention all the nastiness of switch
<det> basicly just a special goto
<det> hunger overwhelming
* det really leaves
<det> oh, one more thing, it gets even nicer with paramaters to the constructors:
<thomas001> another thing: type t = C of int * bool | D of (int * bool);; <-- where is the difference ?
<Riastradh> The constructor is the difference.
<lus|wazze> C is a constructor which takes two arguments, one of type int ,one of type bool
<lus|wazze> D is a constructor which takes one argument, a tuple consisting of an int and a bool
<det> type foo = A of float | B of int * int | C
<det> let print_foo f =
<det> match f with
<det> A(a) -> Printf.printf "A %f" a
<det> | B(a, b) -> Printf.printf "B %d %d" a b
<det> | C -> Printf.printf "C"
<Riastradh> lus|wazze, er, that's the same thing, isn't it?
<thomas001> i thought int*bool is also a tuple....
<det> no
<Riastradh> # type t = C of int * bool | D of (int * bool);;
<Riastradh> type t = C of int * bool | D of (int * bool)
<Riastradh> # C (1,true);;
<Riastradh> - : t = C (1, true)
<Riastradh> # D (1,true);;
<Riastradh> - : t = D (1, true)
<thomas001> so (int*bool) is different from int*bool ?
<det> thomas001: it's the same as a function that takes 2 arguments compared to a function that takes 1 argument which is a tuple of 2 elements
<lus|wazze> Riastradh, almost the same thing
<lus|wazze> but there is a difference when matching
<lus|wazze> when you do
<lus|wazze> type foo = C of int * bool
<lus|wazze> you CAN
<lus|wazze> 't
<lus|wazze> you CAN't
<lus|wazze> do
<lus|wazze> match x : foo with C x -> (* x is a tuple *)
<det> they are probally represented differently in the bytecode compiler
<det> and the same with the native
<lus|wazze> on the other hand, the representation of the type foo is more efficient than that of
<lus|wazze> type bar = D of (int * bool)
<Riastradh> Oh, that's silly.
<thomas001> lus|wazze: fundamental question: do i call a ctor the same way i call a function?
<det> ctor ?
<Riastradh> Constructor.
<det> thomas001: you call a ctor like you call a function in C
<thomas001> type foo=A of int;; A 1;; <--
<thomas001> looks like a normal function call
<det> yeah, hrmph
<det> maybe I shouldnt talk till I learn ocaml completely :)
<thomas001> sry i dont see a real logic behind all this
<thomas001> # type bar=B of int*int;; <-- does B take one argument of type int*int or 2 arguements each of type int ?
<det> B(1,2)
<Riastradh> Two arguments, each of type int, it seems.
<thomas001> but type bar=B of (int*int) would take one tuple ?
<Riastradh> However, if it were: B of (int * int) it would take one argument, a tuple of two ints.
det has quit [Remote closed the connection]
rox has quit [asimov.freenode.net irc.freenode.net]
rox has joined #ocaml
<thomas001> why must typenames start with small letters?
* Riastradh doesn't like the capitalization rules in OCaml either.
<lus|wazze> because everything except constructor and module names must start with a lowercase letter
<thomas001> but why?
<lus|wazze> well they COULD have done it the other way around
<lus|wazze> but then you would be here asking, "why must typenames start with a capital letter?"
<thomas001> why capitilization rules at all>
<lus|wazze> so it can distinguish constructors from identifiers?
<Riastradh> I see the reason for -having- capitalization rules, but why they are what they are I don't see.
<lus|wazze> well as i said
<thomas001> lus|wazze: aren't the names enough to distinguish?
<lus|wazze> umm no?
<Riastradh> No.
<lus|wazze> how should the parser know that foo is a constructor and not an identifier if there were no capitalization rules
<Riastradh> Not without whole-program analysis.
<lus|wazze> like, say, in
<lus|wazze> match x with foo bar -> ...
<Riastradh> And if you do whole-program analysis, you get compile-times like that of Stalin, which is a Bad Thing.
<Riastradh> (Stalin the Scheme compiler, that is)
<lus|wazze> how does it know that foo and bar are not variables to be bound in the matching
<lus|wazze> instead of constructor names?
Smerdyakov has joined #ocaml
<Riastradh> match foo with bar (baz, quux, zot) -> ...
<Riastradh> What could bar be but a constructor?
<lus|wazze> yes
<lus|wazze> but what about baz, quux, and zot?
<lus|wazze> they could be either
<Riastradh> Indeed.
<Riastradh> I haven't thought about it much, but I think whole-program analysis might help there.
<Riastradh> Well, no, it probably wouldn't.
<thomas001> how should the parser know what foo is? doesn't it keep a list of all identifiers and ctors defined until the line foo appears?
<Riastradh> foo isn't the problem here.
<Riastradh> baz, quux, and zot are.
<thomas001> if baz,... are no ctors and no identifiers they are variables...
<lus|wazze> umm variables ARE identifiers?
<lus|wazze> and how does it know, for example , that they are not defined as ctors in some other module
<Riastradh> Oh, yes, whole-program analysis would work there.
<Riastradh> But you'd need the whole bloody program, which would suck, since a REPL wouldn't work with it, and you couldn't compile each module individually.
lament has joined #ocaml
<thomas001> < Riastradh> match foo with bar (baz, quux, zot) -> ... <-- if baz was a ctor, it whould be listed in a list where all ctors are stored... (sry if i annoy you....)
rox has quit [asimov.freenode.net irc.freenode.net]
<Riastradh> Oh, well, actually...you'd just need the module interfaces.
rox has joined #ocaml
thomas001 has quit [Remote closed the connection]
Smerdyakov has quit ["sleep"]
TachYon has joined #ocaml
mattam has joined #ocaml
lus|wazze has quit ["Quidquid latine dictum sit, altum sonatur."]
lus|wazze has joined #ocaml
reltuk has joined #ocaml
drlion has quit [Read error: 113 (No route to host)]
gene9 has joined #ocaml
TachYon has quit [Remote closed the connection]
foxster has quit [Read error: 104 (Connection reset by peer)]
__DL__ has quit [Read error: 104 (Connection reset by peer)]
foxster has joined #ocaml
__DL__ has joined #ocaml
Yurik has quit ["Client exiting"]
Yurik has joined #ocaml
mattam has quit ["brb"]
mattam has joined #ocaml
mattam has quit [Client Quit]
mattam has joined #ocaml
__DL__ has quit [Read error: 60 (Operation timed out)]
__DL__ has joined #ocaml
TachYon has joined #ocaml
TachYon has quit [Remote closed the connection]
olrion has joined #ocaml
<olrion> yip yip
<docelic|sleepo> hop hop
<mrvn> Wuff Wuff
LordFrith has joined #ocaml
lus|wazze has quit ["Quidquid latine dictum sit, altum sonatur."]
det has joined #ocaml
<det> Any reason why I can't do:
<det> let _ = print_foo B(1,2)
<det> I must group it like:
<det> let _ = print_foo (B(1,2))
<det> where B is a constructor taking 2 ints
<mellum> Well, that's just the way the grammar works... I usually leave a space after the constructor name, that makes it more obvious
<det> (B (1,2)) ?
<det> the grammar sucks :(
foxster has quit [Read error: 104 (Connection reset by peer)]
<mellum> det: Well, at least it's simpler that way...
det has left #ocaml []
det has joined #ocaml
gene9 has quit [Read error: 54 (Connection reset by peer)]
<mrvn> Can one write a function (('a -> ... -> 'b -> 'c) -> 'a -> ... -> 'b -> 'c) -> (('a -> ... -> 'b -> 'd -> 'e) -> 'a -> ... -> 'b -> 'd -> 'e) ?
<mellum> WTF?
<mrvn> I need to transform a function to take one more argument and pass it as the last parameter of its first argument.
mellum has quit ["ircII EPIC4-1.1.11 -- Are we there yet?"]
mellum has joined #ocaml
<mrvn> I need to transform a function to take one more argument and pass it as the last parameter of its first argument.
<cDlm> mrvn: use partial application with labels
<mrvn> How do I do ... with labels?
<cDlm> read the fine manual then just do it :)
<mrvn> nothing about functions with unknown number of parameters in there as far as I see.
<cDlm> yes you cant manipulate such functions in caml
<mrvn> # let int cont (x:int) = cont x;;
<mrvn> val int : (int -> 'a) -> int -> 'a = <fun>
<mrvn> # let ($) = fun x y cont -> y (x cont);;
<mrvn> val ( $ ) : ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c = <fun>
<mrvn> # int $ int;;
<mrvn> - : (int -> '_a) -> int -> '_a = <fun>
<mrvn> # fun cont -> (int $ int) cont 1 1.;;
<mrvn> - : (int -> float -> 'a) -> 'a = <fun>
<mrvn> Why is int $int not of type (int -> int -> 'a) -> int -> int -> 'a?
<__DL__> Have you looked to cpsio ? the do something like that...
<mrvn> They only do output
<__DL__> mmm, yes.
<__DL__> may be there is something to be donne from the haskell parsing lib
<__DL__> but I'm not sure caml type system is able to type it.
<mrvn> I don't understand why the above doesn't get fully typed.
<det> mrvn, look at monads for dummies
<det> mrvn, looks very similar to what you are doing
olrion_ has joined #ocaml
delYsid has joined #ocaml
<mrvn> monads are similar.
<det> well, it implements a continuation monad
<det> I dunno if you looked at it
<mrvn> I did
olrion has quit [Read error: 110 (Connection timed out)]
reltuk has quit ["Client exiting"]
docelic|sleepo is now known as docelic
olrion_ has quit [Read error: 54 (Connection reset by peer)]
docelic has quit [Read error: 113 (No route to host)]
docelic has joined #ocaml
<cDlm> still that typing problem...
<cDlm> (id.mli) module type ID = sig type t end
<cDlm> module Make:ID
<cDlm> (id.ml) module type ID....
<cDlm> module Make = struct type t = int end
cDlm has quit [asimov.freenode.net irc.freenode.net]
Zadeh has quit [asimov.freenode.net irc.freenode.net]
gl has quit [asimov.freenode.net irc.freenode.net]
cDlm has joined #ocaml
Zadeh has joined #ocaml
gl has joined #ocaml
<cDlm> then in my code:
<cDlm> module Aid = Id.Make module Bid.make (* Aid.t & Bid.t are the same *)
<cDlm> i have to do module Cid:Id.ID = Id.Make to get incompatible types
<cDlm> isn't there a way to *not* explicitly do that 'cast'
<cDlm> ?
olrion has joined #ocaml
lus|wazze has joined #ocaml
karryall has joined #ocaml
systems has joined #ocaml
systems has quit [Client Quit]
rhil is now known as rhil_daytrip
<det> is .Make something special in ocaml ?
<det> or some kind of common pattern to have top level modules contain a Make module that does something ?
<lus|wazze> well by convention, in ocaml, you call functors Make
<det> I see
gl has quit [asimov.freenode.net irc.freenode.net]
cDlm has quit [asimov.freenode.net irc.freenode.net]
Zadeh has quit [asimov.freenode.net irc.freenode.net]
cDlm has joined #ocaml
Zadeh has joined #ocaml
gl has joined #ocaml
det has quit ["Hey! Where'd my controlling terminal go?"]
Smerdyakov has joined #ocaml
cDlm has quit ["Reconnecting"]
cDlm has joined #ocaml
Smerdyakov has quit ["frolicking for apartments!"]
drlion has joined #ocaml
rhil_daytrip is now known as rhil
olrion has quit ["I like core dumps"]
lus|wazze has quit [""I personally think we need public floggings of senators that do stupid things. Think about it: It would condition them not t]
systems has joined #ocaml
TachYon has joined #ocaml
karryall has quit ["bye"]
TachYon76 has joined #ocaml
<mrvn> Why is "let foo bar baz = blub blubber bar baz" different from "let foo = blub blubber"?
<mrvn> The later has a "'_a" that cannot be generalized.
<Riastradh> That's the way the type system works -- partial applications aren't generalized.
<mrvn> # let bar x = foo x;;
<mrvn> val bar : ('a -> 'b) -> 'a -> 'b = <fun>
<mrvn> # let bar = foo (fun x -> x);;
<mrvn> val bar : '_a -> '_a = <fun>
<mrvn> Why are those different?
<mrvn> ah, nevermind., the x generalised 'a and 'b
<mrvn> Doesn#t that make currying rather useless across modules?
<Riastradh> I don't think so.
<Riastradh> List.map (blub blubber bar) list (* the first argument is only ever going to get arguments of one type *)
<mrvn> Riastradh: But you can't use List.fold partially to specify list.map.
<Riastradh> That's true.
<Riastradh> OK, the OCaml type system is a little screwey.
Yurik_ has joined #ocaml
<Riastradh> Go Haskell!
* Riastradh ducks.
systems has quit ["Client Exiting"]
<mrvn> Does that make code generation easier because fully applied it generates the currying code?
TachYon has quit [asimov.freenode.net irc.freenode.net]
cDlm has quit [asimov.freenode.net irc.freenode.net]
mattam has quit [asimov.freenode.net irc.freenode.net]
wrunt has quit [asimov.freenode.net irc.freenode.net]
TachYon has joined #ocaml
cDlm has joined #ocaml
mattam has joined #ocaml
wrunt has joined #ocaml
Yurik has quit [Read error: 104 (Connection reset by peer)]
foxster has joined #ocaml
mrvn_ has joined #ocaml
<Riastradh> That's odd...
<Riastradh> let filter f (* note the lack of a third parametre *) = List.fold_right (fun ...) []
<Riastradh> is generalized.
<mrvn_> re
<Riastradh> And also: let remove f = filter (compose not f)
<Riastradh> is generalized.
<mrvn_> Ok, but its type is fully specified by the first few parameters.
<Riastradh> Ah, right.
mrvn has quit [Read error: 110 (Connection timed out)]
cDlm_ has joined #ocaml
cDlm has quit [Killed (NickServ (Ghost: cDlm_!cdlm@lns-th2-5-82-64-68-78.adsl.proxad.net))]
cDlm_ is now known as cDlm
mrvn_ is now known as mrvn
TachYon76 has quit ["Client Exiting"]
systems has joined #ocaml
systems has quit ["Client Exiting"]
Yurik_ has quit [asimov.freenode.net irc.freenode.net]
rox has quit [asimov.freenode.net irc.freenode.net]
rox has joined #ocaml
Yurik_ has joined #ocaml
docelic is now known as docelic|away
TachYon has quit [Remote closed the connection]
rhil has quit [Read error: 60 (Operation timed out)]
rhil has joined #ocaml
mattam has quit ["Refuse patents: http://petition.eurolinux.org/"]
Zadeh has quit [Read error: 104 (Connection reset by peer)]
Zadeh has joined #ocaml
pattern_ has quit ["..."]