<mrvn>
val print_board : [< `B | `E | `O | `X] -> unit = <fun>
<mrvn>
# let me = `X;;
<mrvn>
val me : [> `X] = `X
<mrvn>
# print_player me;;
<mrvn>
x- : unit = ()
<mrvn>
# print_board me;;
<mrvn>
x- : unit = ()
<palomer>
X is not defined as a variant!
<palomer>
is that the major dinstinction? no need to declare it in a sum type?
<mrvn>
You can but you don#t have too.
<mrvn>
# type player = [`O | `X];;
<mrvn>
type player = [ `O | `X]
<palomer>
whats the < mean?
<mrvn>
# let print_player = function (`X : player) -> print_char 'x' | `O -> print_char 'o';;
<mrvn>
val print_player : player -> unit = <fun>
<palomer>
why would you ever want to use non polymorphic variants?
<mrvn>
palomer: [< `O | `X] means that it can be `X | `O (a player) or anything less.
<mrvn>
Like [> `X]
<mrvn>
polymorphic variants just have to be subsets to be valid arguments to a function.
<palomer>
they're a million times more flexible than normal variants!
<palomer>
what's the tradeoff?
<mrvn>
polymorphic variants use hashes to match. That can be faster or slower than normal variants.
<palomer>
so it's speed
<mrvn>
# let print_player = function `X -> print_char 'x' | `O -> print_char 'o' | _ -> assert false;;
<mrvn>
val print_player : [> `O | `X] -> unit = <fun>
<mrvn>
# print_player `FOO;;
<mrvn>
Exception: Assert_failure ("", 79, 91).
<mrvn>
Also the type can be pretty loose.
<palomer>
can you do something like let x = `X::x ;; let x = `Y::x;; ?
<palomer>
so you lose some type safety along the way
<palomer>
gotcha
<mrvn>
# let x = [];;
<mrvn>
val x : 'a list = []
<mrvn>
# let x = `X::x ;;
<mrvn>
val x : [> `X] list = [`X]
<mrvn>
# let x = `Y::x;;
<mrvn>
val x : [> `X | `Y] list = [`Y; `X]
<palomer>
so the rule is only use polymorhic variants when needed
<palomer>
so as to take advantage of type safety
<mrvn>
palomer: You don#t loose type safety. You just have a different idea of types.
<palomer>
you can insert any polymorphic type in x!
<mrvn>
You can write a function that takes A | B | any other
<palomer>
if it was non polymorphic, you'd be restricted to the variants in a specific sum type
<mrvn>
You can also restrict the type to a certain set
<palomer>
how would you write a function that takes A | B | any other?
<palomer>
I thought constructors were unique!
<mrvn>
The main advantage would be to include objects of a smaller set in a larger set.
<mrvn>
They are.
<palomer>
how do you restrict polymorphic variant functions to sets?
<palomer>
or lists
<palomer>
or any containers for that matter
<mrvn>
type player = [`O | `X];;
<mrvn>
let print_player = function (`X : player) -> print_char 'x' | `O -> print_char 'o';;
<mrvn>
# print_player `E;;
<mrvn>
This expression has type [> `E] but is here used with type
<mrvn>
player = [ `O | `X]
<palomer>
ahh, gotcha
<mrvn>
Thats why you have [ ], [< ] and [> ]
docelic|away is now known as docelic
<mrvn>
`E is a set that include `E and possibly more.
<mrvn>
type [> `E]
<mrvn>
The player type would be just the two variants.
<palomer>
[> `E] may include more?
<palomer>
[ `E ] would just include E?
<palomer>
what would [< `E ] include?
<mrvn>
It is valid for all functions that have a `E in their set.
<mrvn>
palomer: `E or anything smaller.
<palomer>
smaller?
<mrvn>
Which doesn#t realy make sense.
<palomer>
> means anything greater?
<palomer>
variants are ordered?
<mrvn>
# let foo = function `E -> 0 | `F -> 1;;
<mrvn>
val foo : [< `E | `F] -> int = <fun>
<palomer>
erm
<mrvn>
foo acepts `E, `F and `E|`F types.
<palomer>
ohmy, you can union them?
<mrvn>
smaller meaning subset.
* palomer
kills self
<palomer>
con you union normal variants?
<mrvn>
palomer: No, only typewise.
<palomer>
typewise?
<mrvn>
type player = [`O | `X];;
<palomer>
what's the use of naming your types?
<mrvn>
# type only_E = [ `E ] and only_F = [ `F ] and both = [ `E | `F ];;
<mrvn>
type only_E = [ `E]
<mrvn>
type only_F = [ `F]
<mrvn>
type both = [ `E | `F]
<mrvn>
just shortcuts for restricting types.
<palomer>
ok, how do you use those types now?
<mrvn>
# let foo (x : both) = match x with `E -> 0 | `F -> 1;;
<mrvn>
val foo : both -> int = <fun>
<mrvn>
just like any other type.
<mrvn>
You can also cast polymorphic types:
<mrvn>
# let an_E = (`E : only_E);;
<mrvn>
val an_E : only_E = `E
<mrvn>
# foo (an_E :> both);;
<mrvn>
- : int = 0
<palomer>
:O
<mrvn>
That way you can grow some variant types by some more values without rewriting all the function.
<palomer>
so is there a distinction between a function that takes [< `E | `F ] and one who takes [ `E | `F ]?
<palomer>
would i use it any differently?
<mrvn>
Yes.
<mrvn>
# let foo = function `E -> 0 | `F -> 1 and bar (x : both) = match x with `E -> 0 | `F -> 1;;
<mrvn>
val foo : [< `E | `F] -> int = <fun>
<mrvn>
val bar : both -> int = <fun>
<mrvn>
both being [ `E | `F ] from above.
<mrvn>
# foo an_E;;
<mrvn>
- : int = 0
<mrvn>
# bar an_E;;
<mrvn>
This expression has type only_E = [ `E] but is here used with type
<mrvn>
both = [ `E | `F]
<mrvn>
The first variant type does not allow tag(s) `F
<mrvn>
[ `E ] doesn't fit a [ `E | `F ]
<mrvn>
its smaller.
<mrvn>
# `E;;
<mrvn>
- : [> `E] = `E
<mrvn>
# bar `E;;
<mrvn>
- : int = 0
<mrvn>
[> `E] fits [ `E | `F ] because that `E or more.
<mrvn>
You can restrict your types and functions to subsets, exact matches or supersets.
<palomer>
ahh, gotcha
<palomer>
where is an_e defined?
<mrvn>
Back to the game example. A path finding function would only need to know where the board is empty. You would type it as [> `E ] board -> path
<mrvn>
# let an_E = (`E : only_E);;
<mrvn>
val an_E : only_E = `E
<mrvn>
The pathfinding function would work with anything that has `E on its board to declare empty fields.
<mrvn>
One function and it works with just `X and `O or with `Blocks or a set of 1000 different pieces.
<palomer>
why would you vere want to limit the type of a variable to a subset?
<palomer>
so that it never becomes the input of a function that takes the strict set?
<mrvn>
If you have multiple groups of polymorphic variants.
<palomer>
ahhh, starting to understand
<mrvn>
Like colors and fruits and smells.
<palomer>
so a function that takes player piece info would be foo = function (x:black_or_white)
<palomer>
while one that takes board pices would be (x:black_or_white_or_empty_or_blocked)
<mrvn>
type colors = [ `Red; `Green`; `Yellow; `Blue; ] and traffic_light_colors = [ `Red; `Yellow; `Green; ]
<mrvn>
palomer: yes.
<palomer>
ahhh
<palomer>
so it's a safety mechanism
<palomer>
starting to understand
<mrvn>
But you probably would want to allow players to be used as board pices.
<mrvn>
so [< ... ] for board piece.
<mrvn>
But that allways depends and what you need.
<palomer>
so that's what naming sum types is good for!
<palomer>
mrvn, you rock
<mrvn>
The naming is just so you don't allways have to type it.
<mrvn>
(x : player) is somewhat more readable than (x : [ `X | `Y ])
<palomer>
so optional arguments are polymorhic, with [> `None ; `Sum ] ?
<mrvn>
optional arguments?
<palomer>
let foo ?x = function None -> 3 ; Some -> 4;;
<palomer>
brb
<mrvn>
No, they are just plain option types.
<mrvn>
?x saves you from using None | Some x
<mrvn>
Thats just syntactic suggar
<palomer>
back
<palomer>
option types?
<mrvn>
# let x = Some 1;;
<mrvn>
val x : int option = Some 1
<mrvn>
?x is just a normal option.
<palomer>
haven't seem option types
<mrvn>
# type 'a option = None | Some of 'a;;
<mrvn>
type 'a option = None | Some of 'a
<palomer>
ahh
<palomer>
gotcha
<mrvn>
Its a buildin variant type.
<palomer>
so option is a sum type
<mrvn>
yes.
<palomer>
this is getting interesting:o
<mrvn>
But since you need it so often its predefined
<palomer>
so methods are slow binding right?
<palomer>
meaning I can change the method of a class
<palomer>
of an object I should say
<palomer>
correct?
<mrvn>
And its called variant or enumerated types if all alternatives are constants
<mrvn>
How would you change the method of an object?
<mrvn>
do you mean virtual functions or function overloading?
<palomer>
erm
<palomer>
let foo = object method bar = foobar;;
<palomer>
let barfoo = new foo;;
<palomer>
can I change barfoo.bar?
<mrvn>
nope.
<palomer>
erm
<palomer>
1 sec, lemme look it up
<mrvn>
first its not mutable and second I don't think methods can be.
<palomer>
ahh, it was that methods used within methods are slow binding
<mrvn>
# class foo = object method bar = "bar" end;;
<mrvn>
# class foobar = object inherit foo method bar = "foobar" end;;
<mrvn>
# let foo = new foo and foobar = new foobar;;
<palomer>
let foo = object method bar x = a x ; a x -> 3;; let foobar = object inherit foo method a x -> 4;;
<mrvn>
# let l = [ foo; foobar];;
<mrvn>
# List.map (fun x -> x#bar) l;;
<mrvn>
- : string list = ["bar"; "foobar"]
<palomer>
I mean method calls within methods
<mrvn>
palomer: What language is that?
<palomer>
:o
<palomer>
palocaml
<mrvn>
Certainly nothing my ocaml compiles.
<mrvn>
But I think what you try to say is that methods are dispatched through a virtual table.
<palomer>
method bar x = self#a
<palomer>
there we go
<palomer>
yes
<palomer>
doesn't that slow things down?
<mrvn>
# class foo = object method foo = 0 end;;
<mrvn>
Thats the same as
<mrvn>
# type foo = { foo : unit -> int; };;
<mrvn>
# let make_foo = { foo = fun () -> 0; };;
<mrvn>
It means that you have to lookup a function pointer each time a function is called.
<mrvn>
Usually its slower.
<mrvn>
Thats one thing I don't quite like in ocaml.
<palomer>
speed?
<palomer>
ocaml is speedy quick!
<mrvn>
But its cleaner.
<mrvn>
palomer: amasingly speedy usually.
<palomer>
yhea
<palomer>
I don't know how:o
<palomer>
so what don't you like
<mrvn>
That all methods are dispatched through a function table.
<palomer>
ahh
<palomer>
like java
<palomer>
unlike c++ and c#
<mrvn>
more like C++
<mrvn>
is what I would like
<palomer>
for speed reasons?
<mrvn>
In C++ you can say that method is virtual or static.
<mrvn>
Speedier and sometimes you don't want other classes to mess up your interface.
<mrvn>
e.g. if you have a public method that used internally. Every other class can inherit you and change the method.
<mrvn>
+is
<palomer>
so theres no way of not using the virtual table?
<mrvn>
not for public method.
<palomer>
you could define a method relative to a private value, can't you?
<mrvn>
class foo = let bar () = "bar" in object method blub = bar () end
<palomer>
yhea
<mrvn>
bar is just like any other value.
<palomer>
there you do
<palomer>
I mean there you go
<mrvn>
But from ouside the class you still have to use foo#blub
<palomer>
ahh, and it can be overwritten
<mrvn>
blub can but bar not.
<mrvn>
you can also make methods private. That should keep them save.
<mrvn>
not sure on that one though.
<palomer>
so how about (pseudocodish) class foo = private val bar = fun x -> x+2 ; method blub = bar;;?
<palomer>
where blub is public
<mrvn>
palomer: val is private anyway
<mrvn>
class foo = object val x = 0 end, you will never get the x out of the class.
<palomer>
ahh yes
<palomer>
so class foo = val bar = fun x -> x+2 ; method blub = bar;;
<palomer>
pseudo
<mrvn>
Actually that not true. YOu can get the x out of foo:
<mrvn>
# class bar = object inherit foo method bar = x end;;
<mrvn>
So val is only protected
<mrvn>
But without mutable it can't be changed.
<palomer>
bar isn't a method!
<palomer>
what im saying is that instead of having public functions calling public functions, if you want the interface to be the same you have public methods only calling private methods
<palomer>
or private values
<mrvn>
more to type and still slower than static functions.
<mrvn>
But its fast enough anyway.
<mrvn>
My programs usually run only for seconds or for many hours. A 10% doesn#t realy matter much if it runs overnight anyway.
<palomer>
hours?
<palomer>
whoa
<mrvn>
s/10%/10% speed increase/
<palomer>
what's your favourite programming language?
<mrvn>
currently ocaml
<palomer>
more than haskell?
<mrvn>
never used haskell much.
<mrvn>
no compiler for alpha (in Debian) for example.
<palomer>
yhea
<palomer>
haskell won't compile in gcc3.2
<palomer>
well thanks a bunch mrvw
<palomer>
mrvn
<palomer>
back to analysis
TachYon26 has joined #ocaml
TachYon26 has quit ["bez ki³y nie ma zaliczenia (z prawd studentek AM)"]
<vegai>
palomer: ghc compiles fine here
<vegai>
ok, this is not debian, but still
<vegai>
doublechecks this right now
<vegai>
ah, my distro uses 4.08 to bootstrap
<vegai>
ahh, I guess I remembered wrong. Doesn't compile here ;-/
<palomer>
:o
<palomer>
another roadblock
<whee>
heh, I like haskell more than ocaml D:
<palomer>
what does [> a b ] mean?
<whee>
polymorphic variant, containing those two types and possibly more?
<whee>
just guessing :|
<palomer>
they aren't polymorphic!
<palomer>
that's what I don't understand
<whee>
using backticks when referencing the variants?
<palomer>
eh?
<palomer>
backticks indicate polymorphic variants
<whee>
yes
<palomer>
class container_signals : [> Gtk.container] Gtk.obj -> object end
<palomer>
what does that mean:o?
<whee>
er, might mean something different in that context
<whee>
I don't know lablgtk, so I'm not sure offhand