cjeris changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/
cjeris has quit [Read error: 131 (Connection reset by peer)]
mikeX has quit ["leaving"]
pedro_ has joined #ocaml
fremo has quit [Read error: 110 (Connection timed out)]
joshcryer has joined #ocaml
pedro_soc has quit [Read error: 113 (No route to host)]
david_koontz has quit ["Leaving"]
tree has quit [Nick collision from services.]
tree has joined #ocaml
tree has quit [Nick collision from services.]
tree_ has joined #ocaml
dark_light has quit [Read error: 110 (Connection timed out)]
_blackdog has quit [Remote closed the connection]
screwt8 has quit [Connection reset by peer]
G_ has joined #ocaml
screwt8 has joined #ocaml
G has quit [Nick collision from services.]
Smerdyakov has quit ["Leaving"]
G has joined #ocaml
Smerdyakov has joined #ocaml
G_ has quit [Read error: 110 (Connection timed out)]
screwt8 has quit [Read error: 104 (Connection reset by peer)]
vorago has quit [Read error: 110 (Connection timed out)]
screwt8 has joined #ocaml
vorago has joined #ocaml
postalchris has quit [Read error: 113 (No route to host)]
Submarine has joined #ocaml
slipstream has quit [Read error: 104 (Connection reset by peer)]
slipstream has joined #ocaml
ygrek has joined #ocaml
Smerdyakov has quit ["Leaving"]
_JusSx_ has joined #ocaml
smimou has joined #ocaml
ygrek has quit []
G_ has joined #ocaml
kelaouchi has joined #ocaml
G has quit [Read error: 110 (Connection timed out)]
<flux> hm, the ocaml json precompiler library has taken an interesting approach: instead of sum types, it uses objects
G_ is now known as G
jlouis has quit [Remote closed the connection]
smimou has quit ["bli"]
fremo has joined #ocaml
mikeX has joined #ocaml
reg has left #ocaml []
Sparkles has joined #ocaml
fremo has quit ["reboot: disc dur moisi..."]
<flux> is this a bad pattern to use? I have a list where a function registers a callback for a short period, and to remove itself from the list later, the list is (unit ref * callback) list. the client is removed with List.filter (fun (tag', _) -> tag' != tag) callbacks
<flux> so the 'dilemma' is that it uses physical equality
<flux> is that bad?-o
FlavioG has joined #ocaml
Sparkles has quit []
ygrek has joined #ocaml
mikeX has quit ["leaving"]
FlavioG has quit [Remote closed the connection]
_blackdog has joined #ocaml
<mrvn> flux: Only way to get an unique id
<mrvn> I used a double linked list for that myself. No functional datatype.
<mrvn> flux: like this: http://paste.debian.net/27143
<flux> well, it's not the only way, but it's a very efficient way, especially if threads are involved
<mrvn> flux: List.filter is wastefull. You should write your own function that stops once it finds the callback.
<mrvn> If you have many objects then a dlist will be far faster.
<flux> well, actually the problem was solved by passing Condition.t instead of a callback, and that approach would allow sets or hashtbl to be used
<flux> but realistically I'll rarely, if ever, have more than one registered function
<mrvn> Oh, well. One per socket. For a P2P program that easily comes near 1000.
<flux> yes, but the list of callbacks is already one per socket
<mrvn> Oh, every socket has its own list. In my case the dlist nodes had a buffer, a socket, and any other state info it needed.
<mrvn> I have a similar problem now. I have a huge tree and data structure on disk and I want to keep the least recently used parts of the tree and data in ram. That means I have to keep them sorted by access time and have both parent and child pointers. That doesn't work with a functional tree.
skal has joined #ocaml
<mrvn> Unless I do a find on the tree every time I remove a node.
<mrvn> I guess I can do the extra search. Compared to the load time that should be a minor delay.
_JusSx__ has joined #ocaml
_JusSx_ has quit [Read error: 60 (Operation timed out)]
_JusSx_ has joined #ocaml
Sparkles has joined #ocaml
_JusSx___ has joined #ocaml
_JusSx__ has quit [Read error: 113 (No route to host)]
_JusSx_ has quit [Read error: 113 (No route to host)]
_JusSx_ has joined #ocaml
jlouis has joined #ocaml
_JusSx___ has quit [Read error: 113 (No route to host)]
jlouis has quit [Remote closed the connection]
ita is now known as ita|afk
li` has joined #ocaml
<flux> hm, I just noticed that (of course..) mutual method recursion comes "just works" in methods (whereas with functions you need to use 'let rec.. and')
bzzbzz has joined #ocaml
postalchris has joined #ocaml
kelaouch1 has joined #ocaml
kelaouchi has quit [Connection timed out]
cjeris has joined #ocaml
FlavioG has joined #ocaml
FlavioG has quit [SendQ exceeded]
eradman has quit [zelazny.freenode.net irc.freenode.net]
eradman has joined #ocaml
jlouis has joined #ocaml
<postalchris> hcarty: you catch the existential type parameter post on caml-list?
ygrek has quit [Remote closed the connection]
ygrek has joined #ocaml
jlouis has quit [zelazny.freenode.net irc.freenode.net]
cjeris has quit [zelazny.freenode.net irc.freenode.net]
_blackdog has quit [zelazny.freenode.net irc.freenode.net]
G has quit [zelazny.freenode.net irc.freenode.net]
mrvn has quit [zelazny.freenode.net irc.freenode.net]
Hadaka has quit [zelazny.freenode.net irc.freenode.net]
mrvn has joined #ocaml
_blackdog has joined #ocaml
jlouis has joined #ocaml
cjeris has joined #ocaml
G has joined #ocaml
li` has left #ocaml []
pango has quit [Remote closed the connection]
Naked has joined #ocaml
Naked is now known as Hadaka
Sparkles has quit []
<hcarty> postalchris: Yes, though I'm not sure how to apply it to my case
<mrvn> url?
<hcarty> I'll be working on that today for a while
Hadaka has quit [zelazny.freenode.net irc.freenode.net]
pango has joined #ocaml
<hcarty> It's a little ways down the page, "wrapping parameterized types"
Naked has joined #ocaml
Naked is now known as Hadaka
<mrvn> I wonder if I can use the same existential trick to have an 'l : 'a . ('a * 'a -> 'b) list' and then call List.iter (fun (a, f) -> f a) l where the 'a have different types.
ygrek has quit [Remote closed the connection]
<postalchris> hcarty: well, your application is much more complicated that the list example, but isn't what you want something like "type 'a bigarrayfun = { f : 'b 'c . ('b, 'c, Bigarray.c_layout) Bigarray.Genarray.t -> 'a }" ?
<mrvn> looks right
<hcarty> I think so. I'm still relatively new to OCaml though, so it's taking me some time to trudge through it
<mrvn> # type virt = { this : 'a . 'a; fn : 'a . 'a -> unit; };;
<mrvn> type virt = { this : 'a. 'a; fn : 'b. 'b -> unit; }
<mrvn> # let virt1 = { this = 1; fn = print_int; };;
<mrvn> This field value has type int which is less general than 'a. 'a
<mrvn> :( this doesn't work.
<hcarty> mrvn: I ran in to that same problem yesterday
<postalchris> This works (ignore the Match warning, a result of my laziness): http://rafb.net/p/ldONta57.html
<hcarty> postalchris: Excellent! Thank you very much.
<postalchris> Well, it seems like virt is an attempt to have this be completely untyped...
<postalchris> That doesn't wash
<hcarty> It was a syntax issue ... I didn't know how to use the "." and didn't find anything in the manual about it
<mrvn> type 'a tbl = { this : 'a; fn : 'a -> unit; }
<mrvn> type virt = { tbl : 'a. 'a tbl; }
<mrvn> That looks better typed. But still doesn#t help.
<mrvn> And you would use it with: # let call v = v.tbl.fn v.tbl.this;;
<mrvn> val call : virt -> unit = <fun>
<postalchris> Well, yes. I'm not really understanding the limits of the type system here, either. Like, why is this "existential" type trick only available inside records...?
<mrvn> postalchris: Now that I the 64k$ question.
<mrvn> s/I/is/
<mrvn> hcarty: you can always use classes.
<postalchris> hcarty: the documentation is actually in the "core language" section of the manual (to my surprise): http://caml.inria.fr/pub/docs/manual-ocaml/manual003.html
<postalchris> At the end of Section 1.5. But it's scant.
<postalchris> So far as I can tell, the semantics of ('a . typexpr) are not given in the manual, though.
<hcarty> postalchris: That is an odd location
<mrvn> http://paste.debian.net/27165 <<-- I'm still looking for a way to do this without class without changing the memory eficiency.
fax8 has joined #ocaml
<fax8> hi all, I'm new to the ocaml programming: would someone plese help me understand why http://pastecode.com/31220 does not compile?
<mrvn> Because you are missing a () after the second fst
<mrvn> in ( fst(f(t_txt, t_pivot)) * fst (t(t_txt, t_pivot+1)),
<mrvn> fst(t(t_txt, t_pivot+1)));;
<postalchris> mrvn: what's wrong with objects. Except for, you know, the horrifying syntax?
<mrvn> postalchris: I want to do it without.
<mrvn> Best solution I have is to use Obj.magic to do the (i :> fn) cast.
<postalchris> mrvn: You have a well-typed solution... why nit-pick?
<mrvn> postalchris: Obj.magic is woodoo
<fax8> mrvn: thank you! worked!
<mrvn> postalchris: Like this: http://paste.debian.net/27167
smimou has joined #ocaml
<mrvn> There doesn't seem to be a way without Obj.magic. I thought for a moment the 'a.'a type would help but it doesn't seem to.
<mrvn> fax8: you still get an endless recursion
<postalchris> I thought you had it working with classes and w/o Obj.magic...
<mrvn> postalchris: yes, classes. But not without
<postalchris> Classes are good!
<fax8> mrvn: I know ... I'm trying to let it work ..
<fax8> mrvn: actually I'm not sure that this is the correct way to do this ... I started using ocaml today ... and never used a functional language before
<fax8> mrvn: it is a simple math interpreter .. if I call it using t("2*3", 0);; it should evaluate and return 6
<fax8> sligtly updated: http://pastecode.com/31225
<mrvn> Then you should first tokenize that into 2 * and 3, build t tree and then evaluate
<mrvn> or evaluate as you parse
<mrvn> 12.6 A complete example
<mrvn> The all-time favorite: a desk calculator. This program reads arithmetic expressions on standard input, one per line, and prints their values. Here is the grammar definition:
<mrvn> ...
<fax8> yeah... but it uses some things we still not learned
<fax8> I think I should be able to do it using simple recurring
<mrvn> Ok. Then lets split this up: 1. tokenize the string into its komponents, 2. parse those components and do the calculation.
<mrvn> e.g. type token = Num of int | PLUS | MINUS | MUL
<mrvn> Now you go through the string and create a token list from it
<mrvn> In your example you should get [Int 2; MUL; Int 3]
<mrvn> When you have done that you can do the 2. step using simple recursion
<fax8> I think we should not parse then evaluate
<fax8> but evaluate during parsing ... this is probably why I'm stuck
<mrvn> fax8: so you want to mix the precedence rules for + and * with the recursive evaluation with the recursive string to int conversions?
<mrvn> At least use something like:
<mrvn> # let is_numeric x = (x >= '0') && (x <= '9');;
<mrvn> val is_numeric : char -> bool = <fun>
<mrvn> # is_numeric 'a';;
<mrvn> - : bool = false
<mrvn> # is_numeric '5';;
<mrvn> - : bool = true
<mrvn> instead of int_of_char.
<fax8> thanks for the hint
<mrvn> # let int_of_digit c = (int_of_char c) - (int_of_char '0');;
<mrvn> There is another one for you.
<mrvn> Make lots of little helpers, each one solving a small problem. And then combine them.
Smerdyakov has joined #ocaml
<mrvn> fax8: The first thing I did when we had to do something like that was to use "let explode s = let rec loop acc = function 0 -> s.[0] :: acc | x -> loop (s.[x] :: acc) (x - 1) in loop [] (String.length s - 1)"
<mrvn> # explode "23*42";;
<mrvn> - : char list = ['2'; '3'; '*'; '4'; '2']
<mrvn> Much easier do to the recursion and matching and such with a char list than with a string.
<mrvn> But enough hints now.
<fax8> thanks ... will have to stuck on this a little bit more
LeCamarade has joined #ocaml
<hcarty> postalchris: How would I define a function 'a foo -> t -> 'a? Syntax-wise.
<hcarty> The leading 'a is the part I don't know/understand
<mrvn> type 'a foo = Foo of 'a
<hcarty> mrvn: Sorry, I don't think I was clear. From here: http://rafb.net/p/ldONta57.html I don't know how to write a bigarrayfun
<hcarty> Just using something like Bigarray.Genarray.get doesn't work, it gives me the "...is less general than..." error
<mrvn> You mean assinging a function to { f : 'a . 'a -> 'a }?
<hcarty> Yes, when calling app_to_bigarray
<hcarty> Or applying.. whatever the proper terminology is
<postalchris> hcarty: I too am finding the OCaml is a bit squidgy about these function types...
<postalchris> hcarty: but you don't need to explicitly define a function of type 'a foo -> 'b, you just write it such that it doesn't force a choice for 'a or 'b...
<postalchris> Like: let hd = function x :: xs -> x | [] -> failwith "hd"
<postalchris> If the type of your function is ('a,'b,'c) BigArray.GenArray.t, then you should be OK (modulo some syntactic tom-foolery)
<mrvn> postalchris: Nope. because he is using multiple types on it
<postalchris> s/type/domain type/
<mrvn> This field value has type
<mrvn> 'a. ('b, 'a, Bigarray.c_layout) Bigarray.Genarray.t -> int array -> 'b
<mrvn> which is less general than
<mrvn> 'c 'd. ('c, 'd, Bigarray.c_layout) Bigarray.Genarray.t -> 'e
<mrvn> The 'b gets infered and restricted to a specific type.
<postalchris> Was that in the nopaste? I didn't see it
<hcarty> Which confuses the heck out of me given that the apply (f,f,f,f,f...) method works
<mrvn> Nope. the error wasn't in there
<mrvn> hcarty: in the later cas you have different functions and each gets applied to only one type.
<hcarty> postalchris: I'm trying to find a function which can be applied given the code you pasted
<postalchris> Try dropping one of the quantifiers form teh funtype
<mrvn> The inference doesn#t corss the function boundray to see that (f,f,f,f,f,f,f) is all the same function. It keeps it generic there.
<postalchris> It's the type dependency on 'b that's getting you
<hcarty> mrvn: Ah, ok. Odd, but that makes sense.
<mrvn> postalchris: there is none
<mrvn> # let get a = app_to_bigarray a { f = Bigarray.Genarray.get };;
<postalchris> I mean: type 'a bigarrayfun = { f : 'c. ('a, 'c, Bigarray.c_layout) Bigarray.Genarray.t -> 'a; }
<mrvn> type 'a bigarrayfun = { f : 'b 'c. ('b, 'c, Bigarray.c_layout) Bigarray.Genarray.t -> 'b; };;
<mrvn> That one works with Bigarray.Genarray.get
<mrvn> # Bigarray.Genarray.get;;
<mrvn> - : ('a, 'b, 'c) Bigarray.Genarray.t -> int array -> 'a = <fun>
<mrvn> Notice that the result is coupled to the first argument. 'a is the same in and out.
<mrvn> Your record has them independent which isn't the case.
<postalchris> G-d d-mn static typing...
<hcarty> mrvn: That ends up with problems when you include Int32 and Float* in the apply function though
<hcarty> "This expressions has type int32 but is used with type int"
<postalchris> hcarty: the problem is that you have a function w/ cross-dependencies on 5 or 6 types. This is do-able, but it's just mind-numbingly complex...
<hcarty> Yes... I think I'm going to stick with the apply (f,f,f,f,f,f,f) method for the time being
<mrvn> hcarty: you could probaly do let apply baf = apply_f (baf.f, baf.f, baf.f, baf.f, ....)
<hcarty> mrvn: I'll give it a shot
<postalchris> mrvn: He'll still have to get his types in order. That's the Maxwell's Demon function...
<mrvn> postalchris: The problem is that the apply function needs to be 'a 'b . (('a, 'b, ...) Bigarray -> 'a) itself again. And you can only do that inside a record. I think.
pango has quit [Remote closed the connection]
david_koontz has joined #ocaml
pango has joined #ocaml
pedro_ has quit [Read error: 113 (No route to host)]
pedro_soc has joined #ocaml
<hcarty> mrvn: let apply baf = apply_f (baf.f, ...) doesn't seem to work either. But, as postalchris said, I think this is an issue of having a long type list
<hcarty> So I'm probably losing some step in the complexity
<hcarty> If I break up the bigarrayfun type in to a few types it looks like I may be able to make this work
swater has joined #ocaml
pedro_soc has quit ["Abandonando"]
_JusSx_ has quit [Read error: 148 (No route to host)]
_JusSx_ has joined #ocaml
_JusSx__ has joined #ocaml
postalchris has quit [Read error: 113 (No route to host)]
fax8 has quit ["using sirc version 2.211+KSIRC/1.3.12"]
_JusSx_ has quit [Read error: 60 (Operation timed out)]
LeCamarade has quit [""To walk home.""]
postalchris has joined #ocaml
swater has quit [Read error: 60 (Operation timed out)]
mikeX has joined #ocaml
swater has joined #ocaml
benny has joined #ocaml
romanoffi has joined #ocaml
benny_ has quit [Read error: 110 (Connection timed out)]
vital303 has joined #ocaml
postalchris has quit [Read error: 110 (Connection timed out)]
ita|afk is now known as ita
ita is now known as ita|away
<hcarty> mrvn: If you're interested, here's what I've come up with in a self-contained example: http://rafb.net/p/YN0upt86.html
<hcarty> That can be saved and "#use"d from the toplevel as-is
Hadaka has quit [zelazny.freenode.net irc.freenode.net]
smimou has quit ["bli"]
Naked has joined #ocaml
Naked is now known as Hadaka
bluestorm_ has joined #ocaml
_JusSx__ has quit ["leaving"]
swater has quit ["Quat"]
skal has quit [zelazny.freenode.net irc.freenode.net]
Submarine has quit [zelazny.freenode.net irc.freenode.net]
vorago has quit [zelazny.freenode.net irc.freenode.net]
vorago has joined #ocaml
skal has joined #ocaml
Submarine has joined #ocaml
eradman has quit [zelazny.freenode.net irc.freenode.net]
eradman has joined #ocaml
ulfdoz has quit [zelazny.freenode.net irc.freenode.net]
Submarine has quit [zelazny.freenode.net irc.freenode.net]
skal has quit [zelazny.freenode.net irc.freenode.net]
vorago has quit [zelazny.freenode.net irc.freenode.net]
bluestorm_ has quit [zelazny.freenode.net irc.freenode.net]
romanoffi has quit [zelazny.freenode.net irc.freenode.net]
_blackdog has quit [zelazny.freenode.net irc.freenode.net]
tree_ has quit [zelazny.freenode.net irc.freenode.net]
Amorphous has quit [zelazny.freenode.net irc.freenode.net]
bluestorm_ has joined #ocaml
tree has joined #ocaml
vorago has joined #ocaml
skal has joined #ocaml
_blackdog has joined #ocaml
Submarine has joined #ocaml
Amorphous has joined #ocaml
ulfdoz has joined #ocaml
bluestorm_ has quit ["Konversation terminated!"]
sourcerror has quit [Read error: 113 (No route to host)]
skal has quit [Read error: 104 (Connection reset by peer)]
cjeris has quit [Read error: 104 (Connection reset by peer)]