<mrvn>
Obj.repr afaik is a NOP that only tricks the typesystem to think the value is a Obj.t
<palomer>
yeah, that shouldn't be too much of a problem
<palomer>
struct type t let repr x : t = Obj.magic x end ?
<mrvn>
let repr x = ((Obj.magic x) : t)
<mrvn>
It preserves physical equality so it can't really do anything with the argument.
<palomer>
and it's hashed based on its physical address?
<palomer>
btw, how exactly are values hashed?
<flux>
I don't think you can hash anything by its physical address, because that can change
<mrvn>
By recursively going through the memory representation up to a certain depth and width.
<mrvn>
flux: except functions.
<flux>
mrvn, yeah
<mrvn>
# Hashtbl.hash foo;;
<mrvn>
- : int = 44952997
<mrvn>
# Hashtbl.hash (Obj.repr foo);;
<mrvn>
- : int = 44952997
<palomer>
so functions are hashed based on their physical address
<palomer>
and this is decided at runtime
<mrvn>
alternatively you could put "Hashtbl.hash f" into the h.
<mrvn>
I think that would allow f to be polymorphic too
<palomer>
ah, righto
<palomer>
safer:o
<palomer>
so why don't functions change physical addresses?
<mrvn>
palomer: closures do but not functions.
<mrvn>
functions == the actual code, closure = an functional object with a pointer to the code and already applied args
<palomer>
so the code never moves?
<flux>
palomer, it's mapped from the binary to memory
<mrvn>
why should it?
<flux>
why would it move?
<flux>
it's perfectly compact and its amount never changes
<palomer>
ah, so for every function you need to add it to the binary
<mrvn>
functions only move once, when you load the binary.
jeddhaberstro has joined #ocaml
<palomer>
so every time I write (fun ...) in my code my binary gets bigger?
Yoric has quit []
<mrvn>
palomer: no, that is a closure
<mrvn>
every time your write -> a + b your code gets bigger
<flux>
well, (fun a -> a + b) needs actual function binary also: function pointer + environment gets stored dynamically, the a + b -operation statically
<palomer>
so in (fun x -> {t}), {t} gets added to my binary
Pimm has quit [Read error: 110 (Connection timed out)]
<palomer>
and that expression evaluates to a pointer to the location in the binary
<mrvn>
somewhere you need the actualy code that does t
<mrvn>
try compiling "let foo x y = x + y" and running objdump -d. You will see a symbol containing "foo" that does an addition.
<thelema>
yziquel: Not really - isn't it a pretty straightforward thing to add the required BSS initialization to the dynamic loader?
<thelema>
or to file a bug with the project that they shouldn't assume BSS=0
<mrvn>
doesn't ocaml use the normal dynamic loader?
<yziquel>
thelema: do not understand the first line. i'd like to know where is the piece of code that does the loading. as for filing a bug, i expect it to be closed very quickly with a "BSS *is* supposed to be initialised to 0" (which is the case),
<mrvn>
peper: you can't have cyclic types unless you use "type foo = .. and bar = ..."
<thelema>
peper: if you want to define recursive types you have to define them together: let foo = bar list and bar = foo option
Pimm has joined #ocaml
<peper>
hmm, not really recursive, i want to have a record A with a function taking type B as one of the args and B has a list of A
<peper>
so the and syntax is the way to go?
<mrvn>
that falls under the same deal
<peper>
what if B is a class?
<mrvn>
same limitations. not sure about the syntax
<mrvn>
you can use type classes though
<peper>
type classes?
<mrvn>
class type restricted_point_type =
<mrvn>
object method get_x : int method bump : unit end;;
<mrvn>
class foo = object ... end and bar = object ... end is supported too.
<mrvn>
Anyone know how to do this if only one is an object?
<peper>
mrvn: hmm so a class type is soemthing like an abstract class?
<mrvn>
peper: like a module signature
<peper>
hmm, can a class derive from a class type?
<mrvn>
it can fit a class type
<peper>
then i can make A's function take the B's class type instead and then make B fit it?
<thelema>
peper: functions always take types as argument.
<mrvn>
peper: but B's class type Needs A's function already you said
<thelema>
classes just automatically define types for themselves
<mrvn>
Or do you only need the part that doesn't need A?
<mrvn>
You can use < foo : unit; ..> syntax too
<peper>
ah i see
<peper>
shame the 'and' syntax doesn't work
<mrvn>
it does for type and type or class and class. Can't find one that mixes types and classes.
<thelema>
not common to recurse between records and objects
<palomer>
it is common to recurse between objects and variants, though
<palomer>
I do it all the time
<mrvn>
# type bar = Bar of < foo : bar; ..>;;
<mrvn>
Error: A type variable is unbound in this type declaration.
<mrvn>
In case Bar of (< foo : bar; .. > as 'a) the variable 'a is unbound
<mrvn>
palomer: how?
<peper>
i'm trying to avoid objects as they seem a bit less functional than records
* thelema
remembers palomer having tons of headaches with object types back when, and the consensus was to avoid them as best as possible.
<mrvn>
peper: you can write functional objects
ttamttam has quit ["Leaving."]
<palomer>
type foo = Bar of bar * bar | Baz of foo * bar and class bar = object val mutable body : foo option = None end <--this is the kind of stuff I would like to write
<mrvn>
palomer: or without the "class"
<palomer>
instead I have to write class bar = object val mutable body : ([`Bar of bar * bar | Baz of 'a * bar] as 'a) option = None end
<peper>
mrvn: hmm, mutable fields don't seem functional and w/o them it's a bit cumbersome
<palomer>
thelema, that was YOUR concensus ;P
<palomer>
but yeah, I get enormously annoying type errors
<palomer>
I'd do it differently now
<thelema>
palomer: I still think it's a good one. :)
<palomer>
I'd use datatypes and mutually recursive modules
<mrvn>
peper: I think there is no { foo with x = 17 } syntax for classes.
<palomer>
(and classes)
<mrvn>
palomer: modules can't be mutually recursive
<flux>
mrvn, sure they can, if you define them in the same module
<palomer>
but the signatures can't be recursive, I think
* palomer
wonders why they have that strange restriction
<mrvn>
I was thinking seperate *.ml files
<mrvn>
palomer: because you can always shadow types
<flux>
mrvn, you could promote them into 'real' modules by foo.ml: include Bar.Foo ..
<palomer>
ah, right, toplevels can't be recursive
<palomer>
what's the difference between include and open?
<flux>
include is visible to outside
<mrvn>
flux: right, forgot about that.
<flux>
open is just syntactic candy
<mrvn>
flux: Lucks stupid though if you have 3 files. foobar.ml with all the code and foo.ml just include Foobar.Foo and bar.ml just include Foobar.Bar
<peper>
can i declare a record type inside of the class?
<palomer>
open imports the namespace while include imports the actual code?
<flux>
peper, no
<peper>
bleh ;/
<flux>
peper, well, syntactically it's possible with let module -expression, but it won't do you any good :)
<palomer>
mrvn, I've seen it done, though
<palomer>
I think camlp4 or sexplib does this
tmaeda is now known as tmaedaZ
<mrvn>
palomer: makes sense if you want to hide the interdependency
<palomer>
let module Foo = struct type t = {foo:int} end in {Foo.foo=5}
<peper>
can i make the function take some abstract type but use it as B anyway somehow?
<mrvn>
peper: not unless B is already decalred. And then you can give it B anyway.
<palomer>
actually, I can use let module to solve this!!
<palomer>
class bar = let module Foo = struct type t = Baz of bar end in object val mutable body : Foo.t option = None end
<peper>
mrvn: by function i only meant it's signature, i would define the real functions later
<mrvn>
peper: You might be able to put the type into one module and the class into a second and define them as recursive modules.
<mrvn>
And then include them both.
<palomer>
gah!
<palomer>
doesn't work
<peper>
mrvn: hmm, how can i do that?
avsm has quit [Read error: 110 (Connection timed out)]
<palomer>
why can't I do class bar = let module Foo = ... in object ... end ?
<mrvn>
module rec M : sig type bar = Bar of N.foo end = struct type bar = Bar of N.foo end
<mrvn>
and N : sig class foo : object method foo : M.bar end end = struct class foo = object (self) method foo = M.Bar (self:>foo) end end;;
<mrvn>
What is wrong there?
<mrvn>
Something to do with the self:>foo I guess.
<palomer>
good question, seems ok to me
<palomer>
well, this kind of thing is why I won't use objects again
<mrvn>
yeah, objects do come with some strange errors
<flux>
mrvn, simple fix: replace (self:>foo) with (self:>N.foo)
<peper>
heh, i can't even read that :)
<flux>
with recursive modules you need to refer to the types in the signature
<flux>
to enable recursion
<mrvn>
flux: args
Submarine has quit ["Leaving"]
Associat0r has joined #ocaml
_zack has joined #ocaml
jeddhaberstro has quit [Client Quit]
ikaros_ has quit ["Leave the magic to Houdini"]
valross has joined #ocaml
Smerdyakov has joined #ocaml
fabjan has joined #ocaml
Pepe__ has joined #ocaml
Pepe_ has quit [Read error: 113 (No route to host)]
Pepe_ has joined #ocaml
Pepe__ has quit [Read error: 113 (No route to host)]
bzzbzz has joined #ocaml
ygrek has quit [Remote closed the connection]
_zack has quit ["Leaving."]
Pimm has quit [Read error: 110 (Connection timed out)]
demitar has quit ["Ex-Chat"]
Smerdyakov has quit ["Leaving"]
avsm has joined #ocaml
Yoric has quit []
<yziquel>
thelema: it was a symbol collision. There was a 'box' in /lib/libncurses.so.5 which is loaded very early by ocamlrun...
<yziquel>
collided with the box in libmonetdb5.so.
itewsh has quit ["There are only 10 kinds of people: those who understand binary and those who don't"]
<thelema>
yziquel: impressive debugging
<yziquel>
thelema: gdb is becoming my friend.
<yziquel>
i'm beginning to believe there's only two decent programming languages: ocaml and asm.