cjeris changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/
mikeX has quit ["leaving"]
Z4rd0Z has joined #ocaml
love-pingoo has quit ["Connection reset by pear"]
Morphous is now known as Amorphous
malc_ has quit ["leaving"]
seoushi has joined #ocaml
postalchris has quit ["Leaving."]
Smerdyakov has quit ["Leaving"]
slipstream has joined #ocaml
slipstream-- has quit [Read error: 60 (Operation timed out)]
joshcryer has quit [Read error: 104 (Connection reset by peer)]
<flux>
good morning
slipstream has quit [Read error: 54 (Connection reset by peer)]
slipstream has joined #ocaml
joshcryer has joined #ocaml
bzzbzz has joined #ocaml
bluestorm has joined #ocaml
Z4rd0Z has quit []
bzzbzz has quit ["leaving"]
Amorphous has quit ["shutdown"]
Amorphous has joined #ocaml
benny__ has joined #ocaml
smimou has joined #ocaml
benny_ has quit [Read error: 60 (Operation timed out)]
love-pingoo has joined #ocaml
Submarine has quit ["Leaving"]
bluestorm has quit [Remote closed the connection]
bluestorm has joined #ocaml
screwt8 has quit [Read error: 104 (Connection reset by peer)]
eradman has quit [zelazny.freenode.net irc.freenode.net]
screwt8 has joined #ocaml
eradman has joined #ocaml
smimou has quit ["bli"]
ppsmimou has quit ["Leaving"]
love-pingoo has quit ["Connection reset by pear"]
vital304 has joined #ocaml
vital304 has quit ["Leaving."]
ppsmimou has joined #ocaml
love-pingoo has joined #ocaml
mikeX has joined #ocaml
swater has joined #ocaml
ikaros has joined #ocaml
Ai_Itai has joined #ocaml
Z4rd0Z has joined #ocaml
Ai_Itai has quit ["Leaving"]
ikaros has quit ["segfault"]
<mqtt>
hello?
<bluestorm>
?
<mqtt>
i have a question about structural equality in ocaml. is there an expert around here?
<bluestorm>
(i'm not :p)
<mikeX>
mqtt: just ask
<mqtt>
anyway, that's my question: i'm building graphs, and i have a certain operation on these graphs. I want to find the fixpoint of this operation, so i have to compare two graphs, which are complex structures with records, list etc...
<mqtt>
that's what I wrote:
<mqtt>
let rec find_fixpoint graph = let new_graph = iteration graph in if graph = new_graph then graph else find_fixpoint new_graph
<mqtt>
(sorry for the NL...) Is that ok? will the comparison be ok?
<bluestorm>
seems correct
<bluestorm>
hm
<bluestorm>
if graph is an algebric data type, = will compare it recursively
<mqtt>
my question was something like: if I write graph = new_graph, will both graph be compared right?
<bluestorm>
i guess it will
<mqtt>
what do you mean by algebric
<mqtt>
?
<bluestorm>
hm
<mqtt>
without any mutables?
<bluestorm>
hm
<mrvn>
as long as it has no abstract types that should work I think
<mqtt>
do you know any good reference on this on the web? i couldn't find any
<bluestorm>
hm
<bluestorm>
you may want to read the = code source
<bluestorm>
it's C :-°
<mqtt>
:/
<bluestorm>
(asmrun/compare.c -> caml_equal)
<bluestorm>
but when if your data structure is nice
<bluestorm>
(i mean, when caml has the whole representation : no abstract things, nothing coming from C, etc...)
<bluestorm>
= should work fine
<mqtt>
what do you mean exactly by nice? it's not: i have structs with mutable fields...
<mrvn>
Obj.t, custom or abstract types would be not nice.
<mrvn>
Obj.t would probably work too.
<bluestorm>
mutable fields should work
<mqtt>
is type t = A | B of int an abstract type for you?
<bluestorm>
no
<mqtt>
ok
<bluestorm>
it's an algebric datatype
<bluestorm>
(type foo = Foo of bar * baz | Bar...)
<mrvn>
mqtt: abstract type would be "type foo"
<mqtt>
ok
<mqtt>
now...
<mrvn>
Only way I can think of to break = is to use C.
<mrvn>
so you should be save.
<mqtt>
suppose my iteration function DOES modify the graph 'in place' (by modifying the mutable fields with :=), i suppose this won't work anymore right?
<mqtt>
the let new_graph = iteration graph will be the same as graph?
<mrvn>
mqtt: the = should be atomic
<mrvn>
ahh, no that won't work.
<mqtt>
hehe, ok so... i have to confess, that's what i do :)
<mrvn>
new_graph and graph will be physical the same and always compare.
<mrvn>
clone it
<mqtt>
yes...
<bluestorm>
mutable variables in a recursive data structure is dirty
<mqtt>
right. how mrvn ?
<bluestorm>
couldn't you do without mutable fields ?
<bluestorm>
hm
<mrvn>
Oehm, there is something about that in the ocaml handbook. I would rather not and avoid the mutables.
<bluestorm>
mqtt: suppose your datastruct is
<mqtt>
bluestorm, i know, but it's my only way to do it...
<bluestorm>
type dirty_tree = Empty | Tree of (tree ref) * (tree ref)
<bluestorm>
what you could do is to create a function that would give you a "frozen", unmutable value of your tree
<bluestorm>
type nice_tree = Empty | Tree of tree * tree
<bluestorm>
hm
<bluestorm>
type nice_tree = NEmpty | NTree of tree * tree
<bluestorm>
(constructor conflict isn't nice :p)
<bluestorm>
let froze = function Empty -> NEmpty | Tree (a, b) -> NTree (froze !a, froze !b)
<bluestorm>
froze : dirty_tree -> nice_tree
<bluestorm>
and you fixpoint would be
<bluestorm>
(hmm, let's name it freeze, not froze :-°)
<mqtt>
you're right... maybe i should change the whole data structure...
<bluestorm>
let fixpoint f dirty = let old_nice = freeze dirty in f dirty; if old_nice = freeze dirty then dirty else fixpoint f dirty
<bluestorm>
but i think the best solution would be to have a functional data structure
<mqtt>
i've always found this mix of functionnal and imperative aspects very confusing about caml...
<bluestorm>
hm
<bluestorm>
maybe you should try a purely functionnal language as haskell
<bluestorm>
after that, you would be happy to be able to use imperative aspects in ocaml ^^
<mrvn>
mqtt: Then don't use mutables.
<mrvn>
I think I never used a ref in a recursive type.
<mikeX>
bluestorm: how do you type the little o (grade) symbol?
<bluestorm>
° ?
<mqtt>
i used to program in haskell, but i'm working with the guys who wrote caml, so i don't have any choice anymore :)
<mrvn>
Only mutable in records like type point = { mutable x : int; mutable y : int }
<bluestorm>
on my keymap it's ^ + 0
<bluestorm>
mrvn:
<bluestorm>
have you never used type 'a tree = 'a * 'a tree array ?
<mikeX>
bluestorm: cool, thanks :)
<mrvn>
I used a tree with Map.t once.
<mikeX>
:-⁰)
<mikeX>
hmm, no that's a zero
<bluestorm>
hm
<bluestorm>
not exactly a ° but your ⁰ is really cool too ^^
<mrvn>
bluestorm: array is kind of ugly to resize when the tree grows. I usualy just use 'a tree list
<bluestorm>
sometimes you don't need to resize it
<mrvn>
Plus initializing the array is ugly.
<bluestorm>
i'm using it for a dictionnary tree : each node has 26 children
<bluestorm>
Array.init is cool :-°
<mqtt>
mrvn, bluestorm thx a lot, i'll try to change the data structure and i'll tell you if it worked.
<mrvn>
bluestorm: The problem is that you need a dummy leaf in every arrray slot.
<bluestorm>
that's a little memory cost, but using a association list for example would come at a time cost
<bluestorm>
(i think if you stress the dictionnary a lot, even Map could have a real overhead)
<mrvn>
Map uses a balanced tree, or not?
ikaros has joined #ocaml
<bluestorm>
it does
<mqtt>
err... one more time... if i have say type graph = { id:int; mutable succ:graph list}, and if i eval g1 = g2, what will be compared exactly: the succ list, or the addresses of them? will it compare the two graphs correctly or not?
<bluestorm>
you never have to think about addresses when doing ocaml
<mrvn>
The contents. == is physical (address).
<mrvn>
# "" = "";;
<mrvn>
- : bool = true
<mrvn>
# "" == "";;
<mrvn>
- : bool = false
<bluestorm>
mqtt: it will compare them correctly
<bluestorm>
hm
<bluestorm>
actually "correctly" depends on what you want
<mqtt>
hm, weird.
<mrvn>
I somtimes whish a = b would do a == b || a = b
<bluestorm>
but if the two succ are the same list (they have the same element) it will say they're equal
<mrvn>
If you have alrge trees that are mostly identical then = is rather slow.
<bluestorm>
let ( = ) a b = a == b || a = b
<bluestorm>
:-°
<mrvn>
yeah, did that too.
<swater>
Does it work bluestorm ?
<bluestorm>
why not ?
<bluestorm>
yes, it does
<bluestorm>
let rec a = 1::a;;
<bluestorm>
a = a;; hangs
<swater>
hm, because it seems strange to redefine "="
<bluestorm>
let ( = ) a b = a == b || a = b;;
<bluestorm>
a = a;; return true
<swater>
mh, ok
smimou has joined #ocaml
<mrvn>
bluestorm: Right. I had a self recursive datatype somewhere when I first wanted the smarter (=).
<bluestorm>
:p
Smerdyakov has joined #ocaml
vital303 has quit [Read error: 104 (Connection reset by peer)]
Zarathoustra has joined #ocaml
Zarathoustra has left #ocaml []
Types_and_Kinds has joined #ocaml
Types_and_Kinds is now known as Sparkles
Sparkles is now known as info
info is now known as Types_and_Kinds
postalchris has joined #ocaml
pango has quit [Remote closed the connection]
pango has joined #ocaml
ikaros has quit [Read error: 110 (Connection timed out)]
<flux>
I don't exactly get what you're doing, but considering C++ code typedef void(Base::*memfun)(); .. void do_something(Base& a_obj, memfun func) { (a_obj.*func)(); } then yes, closure would be the one
<mrvn>
flux: any ideas for the url?
postalchris has quit ["Leaving."]
<flux>
mrvn, you don't want to bind a value to a certain table, to allow changing the table associated with a value?
<mrvn>
No. The table is bound to the type. All instances of one type get the same table.
<mrvn>
And all different kinds of types must have an identical table layout to be joined into a Virt.
<flux>
mrvn, a separate closure per each method would be too much?
<mrvn>
They would be bound to the object so you have one table of closures per object. Not a shared one for all instances.
<flux>
I don't really know.. I'm guessing.. a couple dozen bytes?-o
<flux>
could be a lot compared to the actual data
<flux>
otoh, maybe it's just a function pointer and a value pointer
<mrvn>
must be at least tag, function pointer and arguments.
<mrvn>
So in this case 3 words. But is it more?
<flux>
you could maybe measure it. or look at the produced assembler.
<mrvn>
"A closure representing a functional value. The first word is a pointer to a piece of code, the remaining words are value containing the environment."
<mrvn>
from Interfacing with C: 18.2.2 Blocks
<flux>
atleast it optimizes one pointer away
<mrvn>
flux: Problem with your ocde is that "Virt.make" creates a big table for every instance. Think how it looks if you have more than just "print", say 10 functions.
<mrvn>
let make this tbl = fun () -> { print = tbl.print this }
<mrvn>
let print v = (v ()).print
<mrvn>
let make this tbl = fun () -> { print = fun () -> tbl.print this }
<mrvn>
<mrvn>
let print v = (v ()).print ()
<mrvn>
That looks better.
<mrvn>
That should only have a small closure with "TAG fn this" per instance and then create the table of closures on demand.
<mrvn>
I think as class it will still be one word smaller.
<bluestorm>
actually i think "one" and "two" are a bit confusing names
<vorago>
I've changed them to "a" and "b", it's good idea.
<vorago>
And less english also.
<bluestorm>
hm
<bluestorm>
about lists : maybe you could show List.fold_left, it's a funny one
<vorago>
We've been talking even about this one. It's in the TODO list. ;d
<bluestorm>
ok
dark_light has quit [Remote closed the connection]
<bluestorm>
actually i think introducing it at the same time as map wouldn't be satisfying because
<bluestorm>
to code the same think as fold_left with a simple recursive function
<bluestorm>
you really need pattern matching
<bluestorm>
hm
<bluestorm>
of course you can do without (if list = [] then 0 else List.hd + sum List.tl), but it's ugly ^^
<vorago>
It's. I've started writing variant types and matching before lists, but then i found i need tuples.
<vorago>
So I've moved it under lists and tuples.
<vorago>
There's a list matching example in that chapter.
<bluestorm>
hm
<bluestorm>
yes, add_to_list
<bluestorm>
(wich is List.map ((+) 5), actually)
<vorago>
It ends with a few more advanced examples (even with sample of polymorphic variants; If you can think of a better, short, and example which would just interest reader without involving much of the text. ;D)
<bluestorm>
hm
<bluestorm>
by the way
<bluestorm>
your big example with Scanf and a data record is.. strange
<vorago>
Possible.
<vorago>
It's just the way i found it working.
<bluestorm>
i'm not sure the need of a record is clear here (let solve (a, b, c) or let solve a b c would actually be nicer, because 4.0 *. f.a *. f.c is heavier than 4. *. a *. b)
<bluestorm>
hm
<bluestorm>
with "let solve a b c" you could write match Scanf.scanf "%f %f %f" solve with ... :p
<bluestorm>
but even with your data record
love-pingoo has quit ["Connection reset by pear"]
<bluestorm>
i don't think having them mutable is a good idea
<vorago>
True; I can read data into a record, and then just pass the a,b,c data into function.
<vorago>
Or calling the function right away.
<bluestorm>
hm
<bluestorm>
the mutability is a little strange here because it is basically not needed, and then you use it as a global variable
<bluestorm>
wich isn't nice
<bluestorm>
i think your data type is too "unsorted" (without any orientation) to benefit from a record
<bluestorm>
a record whose name are meaningless should be a tuple
<bluestorm>
hm
<vorago>
Yes, but tuples aren't mutable (are they?) I'd just need to rewrite it to use tuples.
<vorago>
(it can be done. This record really is unnecessary)
<mrvn>
And if you only need to change one field you can say let n = { old with b = 1; };;
<bluestorm>
^^
<bluestorm>
mrvn: that won't help us to find a useful mutable record ^^
<bluestorm>
hum vorago
<bluestorm>
you could use mutable records to do C-like linked lists
<mrvn>
type buf = { data : string; start_offset : int; end_offset : int; }
<mrvn>
(+mutable)
<mrvn>
and then you define functions to add to the end of the buffer or read from the start.
<bluestorm>
if youre audience is familiar with C, they might like type 'a ugly_list = { content : 'a; next : mutable 'a ugly_list option }
<vorago>
Hm.
<vorago>
They should be familiar with C. (I'm referencing it sometimes in the text)
<bluestorm>
hm, actually my list type doesn't have a []
<bluestorm>
that's a problem ^^
<mrvn>
call it NIL
<vorago>
It should be variant with NIL and the list... ;)
<vorago>
Then it can be a recursive variant all along...
<bluestorm>
yes but if i end up with a sum datatype, the record goes away
<bluestorm>
hm
<mrvn>
type expr = Int of int | Sum of expr * expr | Prod of expr * expr
<mrvn>
where do you need a record?
<vorago>
We need it, just to show it to people.
<vorago>
;)
<bluestorm>
i was looking for a record example :p
<mrvn>
The ocaml handbook uses Point. { x = 1; y = 2 }
<mrvn>
a geometric example.
<mrvn>
I like my buffer example though. That is actualy quite usefull in RL.
<vorago>
Ok, thanks. I'll fix it somehow. for now -> shower+bed.
<vorago>
I'll read it if you add something more. ;d
ikaros has quit ["segfault"]
Smerdyakov has joined #ocaml
<vorago>
bluestorm, i've retyped that example a bit, but left mutable record.
<vorago>
Data is read in another function now which returns a tuple of a,b,c.
<vorago>
How ever it can be easily stripped... i wonder if it wouldn't be better to do it like this: