olczyk has quit [Read error: 113 (No route to host)]
skylan has quit ["Reconnecting"]
skylan has joined #ocaml
bobov has quit [Remote closed the connection]
gl has joined #ocaml
smklsmkl has quit [Read error: 54 (Connection reset by peer)]
smklsmkl has joined #ocaml
gl has quit [Read error: 104 (Connection reset by peer)]
gl has joined #ocaml
gl has quit [Read error: 104 (Connection reset by peer)]
gl has joined #ocaml
gl has quit [Read error: 104 (Connection reset by peer)]
gl has joined #ocaml
TachYon25 has joined #ocaml
SYStems has joined #ocaml
<SYStems>
is ocaml 3.06 open source
<mrvn>
Its DFSG free
<SYStems>
dfsg ???
<mrvn>
Debian Free Software Guidelines
<SYStems>
which means ???
<mrvn>
Its not only open source but also free software
<SYStems>
great
<pnou>
you want to start learning ocaml SYStems?
<SYStems>
yes i actually downloaded several papers/books and the distribution
<SYStems>
i am more into learning about functional programming so i picked ocaml
<mrvn>
ocaml has good documentation in http with examples.
<mrvn>
Once you learned the basics thats great to learn more.
<SYStems>
:)
<pnou>
if you want to learn functional programming you should also take a look at haskell
<SYStems>
how does it differ ?
<pnou>
haskell is purely functionnal and lazy
<mrvn>
It allows some more functional constructs like iterators.
<pnou>
cleaner syntax, very good library, overloading
<mrvn>
Some things just can't be written in ocaml without violating the type system.
<pnou>
but not efficient at all :/
<mrvn>
But in praxis you won't miss that.
<SYStems>
i am kinda surprised to hear, usually before i pick something to study i do a lil research, and so far i found that ocaml is more appretiated then haskell
<pnou>
well it depends on what you want to do
<SYStems>
i found that i prefer langs that try to implement several paradigms
<SYStems>
the big plan, it i ever could do it... well
<mrvn>
ocaml is realy great to use. haskel has more theoretical applications I think. Its stricter functional.
<pnou>
i use ocaml, but haskell is much more beautiful and cleaner
<pnou>
but beauty is not all i want
<mrvn>
Does Haskel have arrays?
<pnou>
yes
<mrvn>
Functional or with sideeffects?
<pnou>
no sideffects in haskell
<pnou>
there are two types of array
<pnou>
one where the element are fixed at the creation of the array
<pnou>
and you can only access data
<pnou>
one where you can't add element but that is very very unefficient
<pnou>
with functions of type 'a array -> int -> 'a -> 'a array
<mrvn>
With functional arrays you have to copy the array every time you change it. Thats realy slow.
<pnou>
yes
<mrvn>
Its probably more eficient to use lists then.
<pnou>
hard to say, i don't know the way it is implemented
<mrvn>
I prefer to screw beauty and have sideeffects and speed. Makes programming a lot easier sometimes.
<pnou>
i read haskell for papers but i don't use it :)
<mrvn>
Haven't used haskel in years and then only some small exercises while studying.
<pnou>
i agree with you
<pnou>
but is seems that some purely fonctionnal language are pretty efficient
<pnou>
clean for example
<pnou>
and clean doesn't need monad to IO
<pnou>
for ICFP, i and my partern decided to only use purely functional structures for some dark reason and it was really heavy
Good^2B^Free has joined #ocaml
<pnou>
but maybe when you're used to, it's not so heavy
SYStems has quit [Killed (NickServ (Nickname Enforcement))]
<mrvn>
In my eyes IO just has sideeffects. Working around that just makes it unneccessarily complicated.
Good^2B^Free is now known as SYStems
<mrvn>
And using global variables with references is easier than passing an environment through evry function.
<mrvn>
Its possible to work without but its easier to read with.
<pnou>
imho it's also harder to maitain and to read
<pnou>
i like to know that a function is a function
<pnou>
that's written in an haskell type and not in a caml type
<mrvn>
In what way?
<mrvn>
int -> unit is a function, int is not.
<pnou>
no i mean a function according to the math definition
<mrvn>
Can you give me a example? Haven't seen haskel in years.
vague has joined #ocaml
Good^2B^Free has joined #ocaml
SYStems has quit [Killed (NickServ (Nickname Enforcement))]
<pnou>
well it's not complicated, all the haskell function are math function since there are no side effect
mrvn_ has joined #ocaml
<mrvn_>
re
<mrvn_>
Can you give me a example? Haven't seen haskel in years.
mrvn has quit [Killed (NickServ (Ghost: mrvn_!~mrvn@pD9519111.dip.t-dialin.net))]
mrvn_ is now known as mrvn
<pnou>
all the haskell function are math function since there are no side effect
<vague>
Anyone up to why ocaml.org isn't updated?
Good^2B^Free is now known as SYStems
<mrvn>
Oh, in that sense.
<mrvn>
pnou: But you can think of global variables and references as being passed along as a first argument of each function and being returned thereafter.
<pnou>
yes, but it makes the code much more complicated to understand
<mrvn>
Depends on the programming style.
<MegaWatS>
when I want to introduce side-effects , most of the times I use objects with mutable fields
<MegaWatS>
I think that keeps the side-effects encapsulated in a clean way
<pnou>
moreover you must separate IO and computation in haskell, and that's a good thing
<mrvn>
Yes, I like that in ocaml.
<MegaWatS>
you know, you have the object, and that is going to change its state
<MegaWatS>
and nothing else
<pnou>
yep, i use that a lot
<MegaWatS>
and everything else I then try to write in a mostly side-effect free way
<pnou>
i do the same
<MegaWatS>
but there are just some algorithms that work more efficiently and/or intuituvely with side effects
<MegaWatS>
it is as it is written in the ocaml manual
<MegaWatS>
both writing code thats only based on side-effects even where its not needed (aka C/fortran style) and trying to remove ALL side-effects even where they are the most intuitive and logical solution are both artificially emposed coding styles with nothing to do with the problem at hand
<MegaWatS>
ok, it was a different formulation in the ocaml manual but ... :)
<mrvn>
Like writing a heap purely functional.
<pnou>
imho the fact that it's artifical is not a good argument at all
<pnou>
yep but okasaki did it for you :)
<MegaWatS>
well what I mean is, that it is a coding practice emposed that is emposed onto some problem without any sense
<MegaWatS>
when people cling to it like a religion and not let any kind of pragmatism get in their way
SYStems has quit [Read error: 60 (Operation timed out)]
<MegaWatS>
ah here it is
<pnou>
well i don't see the connection, yes there are silly fanatics
<MegaWatS>
I found the quote in question
<MegaWatS>
Concerning programming styles, one can usually observe the two symetrical problematic behaviours: on the one hand, the ``all imperative'' way (systematic usage of loops and assignment), and on the other hand the ``purely functionnal'' way (never use loops nor assignments); the ``100% object'' style will certainly appear in the next future, but (fortunately) it is too new to be discussed here.
<pnou>
but imho purely functionnal language can be better for some task
<MegaWatS>
its in the FAQ about programming style guidelines in ocaml
<MegaWatS>
yes, for some tasks
<MegaWatS>
what I am talking about is people who want to use a pure style no-matter-what and dont let silly little things like facts, efficiency or even simplicity and elegance get in their way
<MegaWatS>
there are algorithms which are better suited to being done in a purely functional style
<MegaWatS>
but on the other hand, there are those for which it is more natural, clean and concise to do them in a more imperative style
vague has quit ["why were the power rangers so easily forgotten?"]
<MegaWatS>
what I mean is this quote: "* The programmer that suffers from this disease carefully avoids to use arrays and assigment. In the most severe forms, one observe a complete denial of writting any imperative construction, even in case it is evidently the most elegant way to solve the problem" to which I agree fully
<pnou>
yes, but you can program in an imperative style in a purely function language though it can be a bit heavier
<mrvn>
Any algorithm that needs arrays can't be translated into a purely functional language without loosing some speed in O(...) notation.
<MegaWatS>
yes you can do that, by always passing and returning the global state along with the actual function arguments
<mrvn>
MegaWatS: You can't set an array element in O(1).
<MegaWatS>
but thats exactly what I mean, making simple and easy thing more complicated, not for practical but for 'religious' reasons so to speak
<mrvn>
Also graph algorithms don#t work well in functional languages because graphs have circular links.
<pnou>
no i mean, with syntactic sugar you can program the same way you did in a, imperative language, but if referential transparency
<MegaWatS>
oh I think it would be possible, with a clever implementation and reference counting you could make functional array updates in-place when the reference count is 1
<pnou>
s/if/with/
<MegaWatS>
once you put that syntactic sugar in there what you have is an imperative language :)
<pnou>
with referential transparency
<mrvn>
MegaWatS: probably, but then you optimise functional into imperative to get the speed back.
<MegaWatS>
not really because you always have to keep in mind that, along with your other parameters, your implicit "world-state" argument is passed and returned
<MegaWatS>
- which is exactly what, from the functional point of view, you imagine to be happening in an imperative language all the time
<pnou>
yes
<mrvn>
Only difference is in the time complexity of some operations.
<pnou>
but with referential transparency
<pnou>
a function is a function and it matters to me
<MegaWatS>
the major difference in my opinion is more in programming style; as we have seen you can write imperative programs in functional languages, but that is also possible vice-versa, its only a matter of how easy it is and with sufficient syntactic sugar both paradigms can be made congruent
<MegaWatS>
pnou, thats not true
<MegaWatS>
once you put in the syntactic sugar to IMPLICITLY pass and return the global world-state with each function call you make, you dont have referential transparency anymore
<pnou>
but it's easy (well at least it seems when i read article :)
<pnou>
you don't implicitly pass the world
<mrvn>
pnou: you can restrict yourself to pure functions even in C.
<pnou>
can gcc prove my functions are pure ?
<MegaWatS>
consider a function foo : world -> int -> (world*int) which foo w i = ({world with counter=w.counter+i},w.counter)
<mrvn>
pnou: its not gcc job.
<pnou>
well i don't agree mrvn
<MegaWatS>
when you make the world-passing implicit what differentiates that function from the C function int foo(int i){static int n=0; n+=i; return (n-i);} ?
<mrvn>
pnou: Thepoint is you could and a compiler could.
<MegaWatS>
a compiler that can prove thaT a function is pure CAN, on the other hand, be useful
<MegaWatS>
the more information nad invariants a compiler can check and enforce, the better
<mrvn>
As long as its not too restrictive.
<MegaWatS>
what do you mean by too restrictive?
<mrvn>
Sometimes all the checks restrict what you can do with the extra knowledge you have.
<MegaWatS>
but the default setting, it is true, should always be the one which encapsulates the other choices
<MegaWatS>
like, in ocaml, functions are as polymorphic as possible, by default
<MegaWatS>
and the set of functions which are NOT necessarily pure, for example, is a superset of the set fo pure functions;
<mrvn>
Now that you mention polymorphic, how do you tell ocaml that tow polymorphic of aclass must be of the same type?
<MegaWatS>
thus, a function should be seen as non-pure by default and only when it is declared as pure should it be treated as such, ajnd the purity enforced also
<MegaWatS>
?
<mrvn>
class virtual foo = object method virtual bar : 'a. ('a->unit) method virtual baz : 'a. ('a->unit) end
<MegaWatS>
hmm
<mrvn>
That has bar : 'a. ('a -> unit) and baz : 'b ('b -> unit)
<MegaWatS>
that 'a. syntax describes a polymorphic method, right? it is new to me as I havent used that new feature of ocaml yet
<MegaWatS>
in that case, that would not be possible, as the 'a type-parameter would be rebound with each call
<pnou>
why don't use a ['a] ?
<MegaWatS>
otherwise, it is not polymorphic :)
<pnou>
it seems that's not polymorphic that you want
<mrvn>
pnou: I want to keep a list of all foo instances so they must be the same type.
<MegaWatS>
if you want to enforce a single binding to the type-variable all over the class you have to make it a type-parameter of the class
<mrvn>
I now have a foo_base with only non polymorphic functions and a ['a] foo that inherits foo_base
<MegaWatS>
hm thats difficult, its true
<MegaWatS>
a type system I have been thinking about now for a while would solve that, but Ive still got some problems with it, and it would certainly not work in the framework of an ml-like language
<pnou>
i don't understand? that's not polymorphic method that you want since you wan't all the argument of the method to have the same type since you handle a list
<mrvn>
pnou: The problem is that I can't have a list of ['a] foo with different 'a.
<mrvn>
I thought that polymorphic functions could solve that.
<MegaWatS>
nope
<MegaWatS>
now I understand whatyou want
<MegaWatS>
and no, you can't have that without keeping run-time type information
<mrvn>
Now I have a list of foo_base instances and I might have to use the magic function to make ['a] foo instances again.
<MegaWatS>
think about it
<MegaWatS>
or you could have a registry for each possible instantiation
<MegaWatS>
like
<MegaWatS>
to cast it to ['a] foo for any specific 'a again
<mrvn>
you mean a to_int, to_float, to_string,... one for each 'a?
<pnou>
you want to store a list of ['a] foo that's it?
<mrvn>
and all but the one thats the right instance throw a Bad_Cast exception
<MegaWatS>
oh if the list of types is very limited you can simply use a variant type
<MegaWatS>
what I meant was via a lookup table
<MegaWatS>
hm
<MegaWatS>
maybe one could even do it with a polymorphic variant
<MegaWatS>
like
<MegaWatS>
[> 'int of (int) | 'float of (float) | ..]
<mrvn>
I don't know the types that might be used and don#t want to restict it to a few. Till now using a foo_base that not polymorphic is enough. i hope I don't need more.
<MegaWatS>
and the casting method is polymorphic
<MegaWatS>
and throws an exception
<MegaWatS>
wopuld that be possible?
<MegaWatS>
thats an interesting idea if it were, no?
<mrvn>
MegaWatS: How do you write a polymorphic cast functions that only works with the right type?
<mrvn>
method foo : 'a. (foo_base -> 'a foo) = match 'a with ... ?
<MegaWatS>
no that doesnt work
<MegaWatS>
it was just an idea I just had
<mrvn>
Would be great but you would have to make some math or if over the type.
<mrvn>
Or you would need type specilisations.
<pnou>
you can use constraint
<pnou>
'a constraint my_variant_type
<mrvn>
constrains?
<MegaWatS>
if I remember correctly , there once was an ocaml extension that could do this
<MegaWatS>
hm constraints shouldn't work in that case imho ... ?
<MegaWatS>
hmm
<pnou>
well i don't know, i don't understand what you want to do
<MegaWatS>
oh I didnt want to do anything I was just brainstorming :)
<pnou>
but i you want to restrict polymorphism contraint is what you need
<mrvn>
That could work.
<pnou>
you can say 'a foo where 'a must be of type t
<mrvn>
Is that a runtime check?
<pnou>
no
<MegaWatS>
but right now I think the idea (even though it doesnt solve mrvn's problem :p) of a polymorphic cast method is kinda neat, at least for down-casting classes ....
<MegaWatS>
I was thinking somewhat along the lines of
<MegaWatS>
let foo = function | `x -> `y | z -> z;;
<MegaWatS>
but a method
<MegaWatS>
and the variant type is used to differentiate between the different sub-classes
<MegaWatS>
hmmm
<MegaWatS>
I wonder if that would be possible
<pnou>
i don't think so
<mrvn>
down-casting should be possible. up-casting need runtime checks.
<MegaWatS>
wait a minute, up-casting is already in the language, or otherwise I've got my directions wrong :)
<mrvn>
How do you up cast?
<MegaWatS>
:> operator?
<mrvn>
Thats down
<MegaWatS>
ok then Ive got my directions wrong :)
<pnou>
that's subtyping
<mrvn>
MegaWatS: or me
<MegaWatS>
I meant UP in the sense of UPwards in the tree of classes
<MegaWatS>
and DOWN in the sense of DOWNwards in the tree of classes
<mrvn>
It all depends where you put the root
<MegaWatS>
and whatI head in mind was a polymorphic method like
<pnou>
one way to upcast is to use class to store instances and them ask the class
<pnou>
something like
<pnou>
class ['a] typedstore =
<pnou>
object
<pnou>
val h = Hashtbl.create 0
<pnou>
method register o = Hashtbl.add h (Obj.repr o) (o:>'a)
<pnou>
method ~retrieve:'b. 'b -> 'a = fun o -> Hashtbl.find h (Obj.repr o)
<pnou>
end
<MegaWatS>
what does Obj.repr do?
<pnou>
it gives a representation of any value
<pnou>
it's type is 'a -> Obj.t
<pnou>
it's type safe
<pnou>
not as Obj.magic
<MegaWatS>
I see
<mrvn>
The html docs don't relay exlain it.
<mrvn>
They just list the functions and types.
<pnou>
obj.mli is not documented
<pnou>
except
<pnou>
(** Operations on internal representations of values.
<pnou>
Not for the casual user.
<pnou>
*)
<pnou>
:)
<MegaWatS>
:p
<mrvn>
The retrieve function returns a 'a, which would be a subtype of all objects stored.
<pnou>
yes you must use a typedstore for each type and the query then each typedstore
<mrvn>
The typedstore just keeps the class intact but doesn't upcast it again.
<MegaWatS>
it also has the drawback of keeping a reference to that class in reachable memory, so it won't be garbage collected
<MegaWatS>
a better implementation would probably somehow use weak pointers for the typedstore, I think
<mrvn>
MegaWatS: You wouln't store it if you don't need it anymore.
<MegaWatS>
yes, but once you don't need it anymore, you will have to remember to remove it from the typedstore
<MegaWatS>
otherwise it won't be collected ... thus, back at manual memory management
<pnou>
[12:52]<mrvn> The typedstore just keeps the class intact but doesn't upcast it
<pnou>
again.
<pnou>
it does
<MegaWatS>
are Obj.t's weak?
<pnou>
no
<MegaWatS>
or are they hashes or somesuch?
<pnou>
you're right for the gc
<mrvn>
pnou: The result of retrieve is a 'a, which must be a base class of all objects stored, right?
<pnou>
yes
<MegaWatS>
right
<mrvn>
So if you store a 'b it gets cast down to 'a and retrieve returns that 'a.
<pnou>
what you store is homogen
<pnou>
you need a typedstode for each type
<pnou>
but you can do #register a and then #retrieve (a :> foo) and foo will be upcasted
<pnou>
a
<pnou>
not foo :/
<MegaWatS>
you need a separate typedstore for each type you need to cast to somewhere
<MegaWatS>
pnou
<MegaWatS>
what do you think
<MegaWatS>
would it be possible
<MegaWatS>
to use this mechanism:
<MegaWatS>
# let foo = function | `a->`b | c -> c;;
<MegaWatS>
val foo : ([> `a | `b] as 'a) -> 'a = <fun>
<MegaWatS>
# foo (`d 5);;
<MegaWatS>
- : _[> `a | `b | `d of int] = `d 5
<MegaWatS>
in a method
<MegaWatS>
to do a kind of polymorphic cast method somehow?
<pnou>
hmmm, how?
<mrvn>
Hmm, what does that mean?
<MegaWatS>
ie a method that gets an open variant type, and when it gets a member of that variant type that it doesnt know about it raises a cast_error
<MegaWatS>
but otherwise it returns the same variant type, but with the respective value
<MegaWatS>
ie
<pnou>
i don't understand how you're going to upcast
<pnou>
you can differentiate class but not upcast
<pnou>
you'll need an Obj.magic somewhere
<pnou>
did i miss something?
<mrvn>
How does that work? Never seen the above syntax.
<mrvn>
pnou: Once you now the right type, Obj.magic is save.
<MegaWatS>
in the 'int' case method foo = function | `int ( i ) -> `int ( i ) | z -> z
<MegaWatS>
and for the other cases alike
<MegaWatS>
hmmm
<MegaWatS>
I mean
<MegaWatS>
in the 'int' case method foo = function | `int ( i ) -> `int ( n_from_the_class ) | _ -> raise Cast_Error | z -> z (*last match case only to illiustrate the typing behaviour *)
<MegaWatS>
problem is only, KNOWING the right type :)
<pnou>
arf
<pnou>
it's easy
<MegaWatS>
one can see in many nice C programs how that works ... or not
<pnou>
but it's not what i call safe
<MegaWatS>
its not safe at all
<mrvn>
What does "val foo : ([> `a | `b] as 'a) -> 'a = <fun>" mean?
<MegaWatS>
that foo returns the same type as it gets
<MegaWatS>
which is, a polymorphic variant type which contains at least the constructors `a and `b