<francisc>
is there a generally preferred tool for generating ocaml bindings to c libraries?
<mrvn>
There is camlidl
<francisc>
Yeah, I've found camlidl, swig-ocaml, c2caml, and ocamlffi, and was trying to see if the ocaml community preferred one. I'll look into camlidl first.
hsuh has quit [Read error: 110 (Connection timed out)]
bjorkintosh has left #ocaml []
seafood_ has quit []
<gildor>
francisc: I was using camlidl before, but I realized that writing C binding without tools is not a big deal, using only OCaml documentatio
<francisc>
Yeah, from what I've seen so far of the available tools I might end up just doing that. I'm trying to produce ocaml bindings to the tokyo-cabinet db and writing it from scratch seems cleaner, too.
<mrvn>
I looked into camlidl and found it a bit confusing and the resulting code elaborate. Writing my own code was like 10% the size.
<mrvn>
camlidl seems to always copy all the data around in a first stub and then call a second stub with the copied data.
ched_ has joined #ocaml
Ched has quit [Read error: 110 (Connection timed out)]
<kaustuv>
well, the variation of that that typechecks
<mrvn>
urgs. That looks rather hackish.
<kaustuv>
I assumed your problem was the possible inefficiency of a sequence of nested ifs, because otherwise there is no problem with your initial version.
<mrvn>
would have liked match kind with x -> ... | y -> ... | z -> ...
<mrvn>
But that would require x when x = idDirKey ->
<mrvn>
would ocaml optimize that into a simple jump table?
<kaustuv>
type id = AllocKey | InodeKey | ...
<kaustuv>
let kind : id = Obj.obj (Obj.repr (Aio.get_uint 8 ... ))
<kaustuv>
no, having I doubt a sequence of x when x = y would be optimised into a compact table, even if all the ys were constants
<det>
I think nested ifs are faster than a jump table in general
<det>
or binary search
<kaustuv>
Certainly nested ifs are faster in bytecode because every jump table has 250 some entries. But in native code, jump tables are generally both faster and more compact.
<mrvn>
I'm wary of anything with Obj.magic. But that seems to be the most readable.
<det>
I am pretty sure that binary search are favored over jump tables when n is small
<mrvn>
hardly.
<kaustuv>
Well, it's not how they're implemented. For normal constructors it's always a straight jump table, and for tagged variants it's chunked binary search with straight jumps inside each chunk.
<det>
Cool, Freenode supports IPV6 now.
<det>
I remember it didn't some years back.
<mrvn>
Hmm, I think ocaml inferes the wrong type:
<mrvn>
if kind = idAllocKey then new allocKey (Int64.to_int major) minor
<mrvn>
else if kind = idInodeKey then new inodeKey major
<mrvn>
else raise (DataError("Key type unknown"))
<mrvn>
val parse_key : Aio.buffer -> allocKey
<mrvn>
inodeKey is not an allocKey. They both are #key_base though.
<kaustuv>
what happens at runtime for kind = idInodeKey?
<mrvn>
No idea
<mrvn>
Hmm, maybe they actualy are the same type. They only differ in the internal variables they have. Not in their methods.
<mrvn>
File "key.ml", line 84, characters 9-100:
<mrvn>
Error: This expression has type inodeKey but is here used with type allocKey The second object type has no method bar
<mrvn>
Yeah. identical interfaces.
<det>
Btw, I was under the impression that GCC uses binary search for switch statements when n is small because it is more efficient.
|jedai| has quit [Read error: 110 (Connection timed out)]
Amorphous has quit [Read error: 110 (Connection timed out)]
marmottine has quit [Read error: 110 (Connection timed out)]
Narrenschiff has joined #ocaml
pierre_m has quit ["Leaving."]
Amorphous has joined #ocaml
marmottine has joined #ocaml
kate_ has joined #ocaml
|jedai| has joined #ocaml
|jedai| is now known as jedai
palomer has joined #ocaml
<palomer>
you can't mutate self, right?
<thelema>
of course objects can modify their own instance variables
<palomer>
I mean do something like class foo = object method bar = self <- new foo end
<thelema>
self isn't mutable
<thelema>
That syntax is for mutable record fields.
<palomer>
right, I meant "something like"
<thelema>
what would you gain from creating a new object and replacing self with it that you couldn't gain by resetting instance variables to default values?
<palomer>
all references that point to my old object would point to my new object, for one
<thelema>
do you just want to change the memory location of the object?
<thelema>
because you can change the instance variables already, and you can't change the vtable... I don't think.
<palomer>
I'd like to overwrite that location with the new object
<palomer>
hrmph, just wondering
<palomer>
sounds dangerous, anyhoo
<thelema>
again, what would you gain by creating a new object as opposed to resetting instance variables of the old one?
<palomer>
again, the references would now point to the new object
<thelema>
if you're overwriting the location of the old object with the new one, there's no change in references.
<palomer>
outside references to the old object
<palomer>
err, not the location of the object
<palomer>
oh, I see your argument
<thelema>
try visualizing objects as records with values for their instance variables and an extra vtable field to a magical structure that handles method dispatch
marmottine has quit [Read error: 110 (Connection timed out)]
ygrek has quit [Remote closed the connection]
komar_ has quit [Remote closed the connection]
ygrek has joined #ocaml
Smerdyakov has joined #ocaml
jamii__ has quit [Read error: 110 (Connection timed out)]
jeanbon has joined #ocaml
<mrvn>
Actualy I wanted to replace self but for the opposite effect. To not have references to the old object point to the new one.
<Smerdyakov>
Anyone want to help me test the new Ur/Web release? If so, go to this URL and then follow the "Chat" link in the left frame. http://www.impredicative.com/ur/demo/
<thelema>
mrvn: that just sounds like the existing object cloning
<mrvn>
Say you have method foo = self#bar; i <- i + 1; self#baz; i <- i + 1; self#buzz; i <- i + 1 and the class is functional.
<mrvn>
s/functional/supposed to be functional/
<mrvn>
method foo = self#bar#foo2 method foo2 = {< i = i + 1 >}#baz#foo3 method foo3 = {< i = i + 1 >}#buzz#foo4 method foo4 = {< i = i + 1 >}
<thelema>
that's what you have to do.
<mrvn>
The problem is that you can not clone+alter anything but self. Would be nice to write something like method foo = self := self#bar; self := {< i = i + 1 >} ... or method foo = let o = self#bar in let o = o#{< i = i + 1 >} in ...
<mrvn>
where o would have to be #'self.
<thelema>
well, for your example, if the intermediate objects aren't exposed to the user, you could use mutability to do kinda that, with only one copy.
<mrvn>
thelema: and use phantom types to turn the object inmutable when returing it to the user?
<mrvn>
or only have private methods that use the mutable things
<mrvn>
You would still need method private foo_mutable = ... method foo = self#mutable_copy#foo_mutable. But I guess that is better than X submethods.
<mrvn>
I sometimes miss that you can not access instance variable of another class of the same type.
<mrvn>
like method compare x = Persvasis.compare value x#value
<Smerdyakov>
Do you mean "another object of the same type"?
<mrvn>
yes
<mrvn>
On the topic of objects: Can I make an instance variable private?
<mrvn>
# class foo = object val private i = 0 end;;
<mrvn>
Error: Syntax error
<bluestorm>
hm
<bluestorm>
aren't instance variable private by nature ?
<mrvn>
# class foo = object val i = 0 end;;
<mrvn>
class foo : object val i : int end
<mrvn>
# class bar = object inherit foo method get_i = i end;;
<mrvn>
class bar : object val i : int method get_i : int end
<mrvn>
they are protected (to used a C++ term)
<bluestorm>
hm
<bluestorm>
so by private you mean unreachable even from the subclasses ?
<mrvn>
yes.
<bluestorm>
you should try
<bluestorm>
hm
<thelema>
class foo = let i = ref 0 in object ... end
<bluestorm>
that's what i wanted to suggest
<mrvn>
hmm, method private is reachable from subclasses too. Good point.
<mrvn>
thelema: doesn't clone well
<bluestorm>
but he might want an instance-specific variable thelema
<thelema>
mrvn: you're right.
<bluestorm>
(so you need a dynamic array and more machinery)
<thelema>
bluestorm: then you just need [class foo () = ...]
<bluestorm>
hm
<bluestorm>
right
<mrvn>
class type foo_type = object end class foo : foo_type = object val i = 0 end;;
<mrvn>
That works.
<thelema>
mrvn: I dunno if that'll prevent subclass access.
<thelema>
but it might.
<mrvn>
# class bar = object inherit foo method get_i = i end;;
<mrvn>
Error: Unbound value i
hsuh has joined #ocaml
<thelema>
good job. I'll file that trick away in my bag.
<mrvn>
The other problem I ran into yesterday was that I wanted a set of classes all based on a common class that fullfill class type comparable = object('self) method compare : 'self -> int end
<mrvn>
The base class has the compare method but then the other classes are no longer subtypes of the base class.
<mrvn>
Something caused by compare in the inherited classes no longer taking a 'self but a #base_class.
<mrvn>
"Similarly, the type money2 below is not a subtype of type money."
<mrvn>
The problem being "as the self type appears in contravariant position"
<mrvn>
Any idea how to write the money2 example so it is a subtype of money again?
<thelema>
doesn't it explain why you can't do that?
<mrvn>
Yes. The question is how do I get around that? money2 doesn't have to be comparable for me but (money2 :> money) does.
<flux>
mrvn, I'm not sure what kind of type system would be able to solve that.. say you put a bunch of money2 with types (but subtypes of money) into one list. what is the code to execute to compare two elements of the list?
<flux>
because if some value has val amount = 42. and another has val count = 42 and they also have corresponding comparison functions.. well, it just cannot work.
<det>
You can't really write a comparable class. You need something like functors or type classes to do this right.
<mrvn>
flux: money2 can't have "count = 42" it inherits money.
<flux>
mrvn, do you (in this example problem) have multiple different kinds of money you would like to compare with each other?
<mrvn>
flux: yes, but only after they are coerced to the base class.
<flux>
mrvn, and if their comparison function works only with the same type, how would it ever work with other classes?
<mrvn>
det: same problem with a type class.
<flux>
I think with a type class you could have n^2 comparison functions
itewsh has joined #ocaml
<flux>
you can do similar solution even without type classes
<mrvn>
the problem is that I can't write (money2 :> money)
<flux>
yes, because the comparison function isn't really suitable
<flux>
you can simply fix that with method compare : parentclass -> int
Smerdyakov has quit ["Leaving"]
<mrvn>
The thing is that cmp : 'self -> int is a more strict type than cmp : #'self -> int. It should see that #'self -> int still is good enough to fullfill the 'self -> int interface but does not pass it on to inheriting classes.
<mrvn>
flux: nope.
<mrvn>
flux: I can't change the comparesignature from 'self -> int to parentlass -> int. the typesystem doesn't let me.
<flux>
mrvn, surely you can. you never write that compare : 'self -> int-thingy. each subclass needs to implement that interface.
<mrvn>
flux: you inherit that.
<mfp>
mrvn: can a meaningful compare be implemented with methods present in the base class?
<mrvn>
mfp: yes.
<mfp>
class virtual base = object method virtual as_base : base method compare : 'a. (<as_base : base; ..> as 'a) -> int = fun x -> (ignore x#as_base); 1 end;;
<mfp>
w/ the actual comparison building on extra (virtual) methods defined in base, for the x#as_base object
<mrvn>
mfp: 'a. (<as_base : base; ..> as 'a) has no method compare so it doesn't match the comparable interface.
<mrvn>
class foo = object(self) method as_foo = (self :> foo) method cmp : 'a. (<as_foo : foo; cmp : 'a -> int; ..> as 'a) -> int = function x -> 0 end;;
<mrvn>
This expression has type foo = < as_foo : foo; cmp : 'a. (< as_foo : foo; cmp : 'a -> int; .. > as 'a) -> int > but is here used with type #comparable as 'b = < cmp : 'b -> int; .. >
<mrvn>
Type 'a is not compatible with type foo = < as_foo : foo; cmp : 'a. (< as_foo : foo; cmp : 'a -> int; .. > as 'a) -> int > Types for method cmp are incompatible
<mrvn>
And even then I don't get it quite right yet.
<mfp>
why do you want a compare method in that type to define compare itself?
<mrvn>
Because without ocaml says "The first object type has no method cmp"
marmottine has joined #ocaml
<mfp>
erm, you're calling x#compare when you do obj#compare x ?
<mrvn>
mfp: x#compare y
<mrvn>
class type comparable = object('self) method cmp : 'self -> int end;;
<mrvn>
let cmp (x : #comparable) y = x#cmp y;;
<mfp>
so in order to compare self with another object, what you do is compare that object with yet something else?
<mfp>
# let cmp (x: #base) y = x#compare y;;
<mfp>
val cmp : #base -> < as_base : base; .. > -> int = <fun>
<mfp>
with the above def, using a self-coercion
<mrvn>
mfp: That would defeat the purpose. The #comparable is in a different module.
<mrvn>
your #base isn't a #comparable.
<mfp>
#base replaces #comparable there
<mfp>
you cannot get it to work with self-types, obviously subclasses are never going to be subtypes
<mrvn>
can't. The point is to have a virtual comparable class, then derive a base class that is comparable and then individual classes that have extra stuff.
<mfp>
and you cannot unify comparable and base exactly because...?
<mfp>
note that with structural typing whether you inherit the virtual class or not doesn't really matter
<mrvn>
because the Tree module should work on any comparable object and not depend on the specific implementation of base.
<mfp>
functorize over the base class?
<mrvn>
This should work with virtual methods.
<mrvn>
I don't see why ocaml couldn't let me coerce (#'self -> int) to ('self -> int).
<mfp>
the problem there is self, not #a -> x :> a -> x
<mfp>
let f (x : <a : int; ..>) = x#a;; # (f :> (<a:int> -> int));;
<mfp>
- : < a : int > -> int = <fun>
<mfp>
Seems to me the only way out is to functorize over the base class. There's no way to coerce to "a nameless base class, no matter what it is": you either have compare : 'self -> int (compare with things of same type) or compare : < as_base : base; ..> -> int (with things that can be coerced to base)
<mrvn>
mfp: The problem is that I can't stop the 'self type from being inherited further down the line. I should be able to say that the 'self stops here and goes no further.
<mfp>
but what you want goes beyond that actually, you want 'self to stop in the 1st subclass of compare (base) and go no further
<mrvn>
mfp: yes. In base I want to say the 'self stops here.
<mrvn>
If I wanted to stop the 'self in compare I just wouldn't use 'self.
<mfp>
right, but then there's no way to write a generic compare : comparable -> int and we're back to a functor taking the base class with compare : base -> int
<mfp>
if you find some other sol, do tell
<mrvn>
class type ['a] comparable = object('self) method value : 'a end
<mrvn>
Why don't they have an RCS that I can browse?
<Yoric[DT]>
wth is that?
<Yoric[DT]>
Is this an April's Fool?
<Alpounet>
what ?
<Alpounet>
Poesia ?
<Yoric[DT]>
Yep.
jeddhaberstro has quit []
<Yoric[DT]>
erf, obviously not
<Alpounet>
Why this reaction ? :-p
<mrvn>
Seems like a huge and complicated overhead to get __FILE__ and __LINE__
<Alpounet>
You can do a feature request on OCaml's standard distribution's tracker, can't you ?
<mrvn>
never tried.
<Alpounet>
It would be *much more* easier.
<Alpounet>
there's probably a "current_line_nb" value somewhere, the trick would be done quite easily.
<mrvn>
Args, the pa_trace.ml opens the input file, reads it in linewise and stores LOC infos in an array.
<Alpounet>
Ah...
<kaustuv>
mrvn: You can get __FILE__ and __LINE__ trivially with camlp4
<mrvn>
kaustuv: can you give me an example?
<Yoric[DT]>
Yeah, but it screws your comments.
Alpounet has quit ["Quitte"]
<palomer>
if a is a polymorphic variant type of the form ([`C1 of t1 | `C2 of t2 | .. | `Cn of tn] as 'a) and b is a variant type of the form ([`C1 of t1['b/'a] | `C2 of t2['b/'a] | ... | `Cn of tn['b/'a]] as 'b) where ['b/'a] represents substitution, is b a subtype of a?
<palomer>
this question has been bothering me for a while
<palomer>
or, rather, is a a subtype of b
<palomer>
actually, make that
<palomer>
if a is a polymorphic variant type of the form ([`C1 of t1 | `C2 of t2 | .. | `Cn of tn] as 'a) and b is a variant type of the form ([`C1 of t1['b/'a] | `C2 of t2['b/'a] | ... | `Cn of tn['b/'a] | `Cp of tp] as 'b) where ['b/'a] represents substitution, is a a subtype of b?
<mrvn>
['b/'a]?
<palomer>
'b for 'a
<palomer>
substitution
<mrvn>
palomer: do you mean that 'b t1 :> 'a t1 for each?
<mrvn>
type a = C1 of int | C2 of float type b = C1 of int * int | C2 of float * float. Like this?
<palomer>
euh
<palomer>
more like type a = C1 of a | C2 of float
<palomer>
type b = C1 of b | C2 of float | C3 of int
<palomer>
the answer, unfortunately, is no :(
<mrvn>
type a = (`C1 of [> `C1 of 'a | `C2 of float ] | `C2 of float) as 'a ?