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)]
ikaros has joined #ocaml
love-pingoo has quit ["Leaving"]
<vorago> Which is more correct:
<vorago> OCaml or O'Caml?
<bluestorm> both are ok
<vorago> Ok!
<Smerdyakov> bluestorm, where do you see a statement that "O'Caml" is correct?
<bluestorm> i don't
<Smerdyakov> So the URL wasn't meant to illustrate that. OK.
<Smerdyakov> I think that "O'Caml" is 100% wrong.
<bluestorm> the URL was a check
<bluestorm> and it failed :p
<vorago> Hm. ;)
<vorago> I was writting constantly O'Caml while keeping in mind to check it sometime.
cjeris has joined #ocaml
<vorago> I'll switch to OCaml and Caml. ;)
<vorago> Thanks.
<Types_and_Kinds> in this book : http://caml.inria.fr/pub/docs/oreilly-book/ocaml-ora-book.pdf, there is O'Caml @ page 200
<bluestorm> :p
<Types_and_Kinds> none of O'Caml or OCaml is wrong... it just depends on your tastes...
<bluestorm> Kinds are cool
swater has quit ["Quat"]
<Types_and_Kinds> you may want or not want to look at this ocaml program : http://philippewang.info/programmation/md5_29lines.ml :-D (sorry for your eyes)
<vorago> Would win Obfuscaded C Code Contest.
<vorago> (They would not guess it's not a C... ;p)
<Types_and_Kinds> the C version is even more obfuscated...
<Types_and_Kinds> (again... sorry for your eyes)
Types_and_Kinds has quit []
mqtt has quit ["Quitte"]
dark_light has joined #ocaml
<mrvn> md5_29lines.ml is ugly. The first and last line is too short.
pango has quit [Remote closed the connection]
love-pingoo has joined #ocaml
pango has joined #ocaml
<bluestorm> hm
<bluestorm> but the 3.10 isn't released yet
malc_ has joined #ocaml
<tsuyoshi> that's ok
<tsuyoshi> you can still get it from cvs
<bluestorm> hm
<bluestorm> do you know what are the developpers waiting for the release ?
<tsuyoshi> no idea
Submarine has joined #ocaml
<mrvn> Does any of the developers hang around here?
<vorago> raise Developer_not_found;
<vorago> Ok.. it wasn't especially funny. ;p
<mrvn> Wouldn't that be raise Developer.Not_found?
<vorago> Hmhmhm. That could be a better implementation.
<vorago> try Developer.find(`Any) with
<vorago> Developer.Not_found -> printf "Nah, as usual";
<mrvn> I wonder if this could be written nicer without using "class": http://paste.debian.net/25858
<mrvn> Esspecially it would be ncie not to have 'a tbl defined in Virt.
love-pingoo has quit ["Connection reset by pear"]
<flux> why not "class"?
<mrvn> Does ocaml have something like member pointers in c++?
<mrvn> flux: overhead
<mrvn> and I don't want to write functional classes.
<mrvn> Member pointer as in let get record member = record.member
<flux> so you're worried about the overhead, when not considering using a closure for that?
<mrvn> flux: like let get record closure = closure record?
<mrvn> get record (fun x -> x.member)
<mrvn> http://paste.debian.net/25860, slightly neater.
<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.
<mrvn> unless...
<mrvn> yeah. I was getting there. :)
<mrvn> How big is a closure in memory?
<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.
Z4rd0Z has quit []
<vorago> bluestorm, http://bla.thera.be/ocaml/ second release.
<vorago> I hope I fixed most of the problems we've been talking about. (but it still e.g. lack fold_left example)
<vorago> mrvn, also for you. ;)
Smerdyakov has quit ["Leaving"]
love-pingoo has joined #ocaml
<bluestorm> hm vorago
<bluestorm> "Step by step you're gonna make yourself code better"
slipstream has quit [Read error: 54 (Connection reset by peer)]
<bluestorm> here, you could quote Alan Perlis : « A language that doesn't affect the way you think about programming, is not worth knowing. »
slipstream has joined #ocaml
<vorago> bluestorm, hm. ;)
<vorago> nice quote.
<vorago> title is taken from song by Archive, titled "Sane".
<bluestorm> hmm
<bluestorm> i have some remarks
<bluestorm> # let add2 a b =
<bluestorm> let sum = a+b in
<bluestorm> sum
<mrvn> let add2 = (+)
<bluestorm> at this point, it might be interesting to that that actually, a + b is just syntaxic sugar for ( + ) a b
<vorago> go on; I'll store them with the previous in OCAML-TALK and fix whatever I can.
<bluestorm> ( + ) is the same as sum and add2
<mrvn> Most people don't know about '( infix-operator )' at the start.
<bluestorm> hm mrvn
<bluestorm> you should'nt write (+)
<vorago> There's a comment that arythmetic operations are just 2-argument functions defined in Pervasives.
<mrvn> bluestorm: ?
<vorago> At the end of "funkcje jako warto¶ci"->Functions as values
<bluestorm> mrvn: if you show (+) to begginers, they'll be owned at (*)
<mrvn> hehe.
<bluestorm> hum vorago
<mrvn> ((**)*(**))
<vorago> Lol.
<bluestorm> the caml guidelines advice people to put space around every symbol
<bluestorm> a*b + c -> a * b + c
<mrvn> I often use (a-1)
<bluestorm> if you show a*b to beginners, they'll be owned at a*!b ^^
<mrvn> But only in the +1 or -1 case usualy.
<mrvn> a*!b?
<mrvn> What is *!?
<bluestorm> if b is a ref
<bluestorm> they'll write a*!b
<bluestorm> (or a+!b or anything else)
<mrvn> And the tokenizer will see *! as infix operator and then ocaml complains it is unbound?
<bluestorm> so for more uniformity, i think it's a good idea to put spaces everywhere
<bluestorm> mrvn: of course :p
<bluestorm> i think there is one onlye case where it's very difficult to put spaces each time, it's ::
<vorago> I fixed operators.
<bluestorm> but actually :: isn't an infix function so we could say it doesn't count :-°
<mrvn> why?
<bluestorm> vorago: you may be interested in the caml guidelines : http://caml.inria.fr/resources/doc/guides/guidelines.en.html
<bluestorm> hm
<bluestorm> btw.
<bluestorm> # addThree 1;;
<vorago> I've read them yesterday even. However It's hard for me to leave tabs.
<vorago> -> add_three?
<bluestorm> yes
<bluestorm> but this is a matter of taste, i guess
<bluestorm> so do as you like
<bluestorm> but usually caml doesn't use camel case ^^
<bluestorm> hm
<bluestorm> # let compose f g = function x -> f(g(x));;
<bluestorm> if there is no pattern matching
<bluestorm> you can use "fun" instead of "function"
<bluestorm> actually, you can even show that this can be rewritten let compose f g x = f (g x)
<vorago> There's a comment about this;
<bluestorm> hm
<bluestorm> is silnia the polish name for factorial ?
<bluestorm> nice name :p
<vorago> In the deriv example.
<vorago> Deriv is declared both ways.
<vorago> Yep, silnia.
<bluestorm> hm
<bluestorm> i find your tail-recursive fib version a little bloated
<vorago> The second let ... in could be reduced i suppose.
<vorago> It was just used to demonstrate the let...in purpose also. I can strip it; Or are you thinking about something more?
<bluestorm> hm
<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:
<vorago> # let read a b c = (a,b,c);;
<vorago> # scanf "%f %f %f" read;;
<vorago> 23 43 34
<vorago> - : float * float * float = (23., 43., 34.)
<vorago> Now it's rewritten without record. Hmhm.
<vorago> Maybe I'll add a record example later.
ikaros has joined #ocaml
malc_ has quit ["leaving"]
jlouis__ has joined #ocaml
jlouis_ has quit [Read error: 60 (Operation timed out)]
smimou has quit ["bli"]
cjeris has quit [Read error: 104 (Connection reset by peer)]
Mr_Awesome has joined #ocaml