<det>
but I was reponding to mrvn's question from 2 hours ago
<det>
about why you must define a record's type separate, instead of inline in a constructor
<det>
and an even harder example:
<det>
type b = B of {a: int; b: string;}
<det>
let f (B b) = b
<det>
type b = B of {a: char; b: string;}
<det>
what is the type of f now
<Alpounet>
oh ok
<det>
actually, I think Ocaml will reject my second example due to duplicate constructors
<det>
I mean, fields
<det>
(ignoring that fact that it is a syntax error the record in B)
<mrvn>
det: that f is an error. B... is a tagged record. There would be no difference between B b and b.
<det>
typo
<det>
I meant:
<mrvn>
Alpounet: type x = A { x: int; } | B { y: float } ...
<mrvn>
Alpounet: to get a more usefull example.
<det>
type b = B of {a: int; b: string;}
<det>
let f (B x) = x
<det>
what is the type of f ?
<mrvn>
det: b -> b
<orbitz>
no
<det>
it's not b though
<orbitz>
he doesn't return B x
<orbitz>
he returns x
<mrvn>
Which would be equivalent.
<det>
nope
<orbitz>
Nope
<det>
type a = A of int
<det>
a and int are distinct
<mrvn>
det: you are mising the point. I want them to be equivalent.
<det>
what about
<orbitz>
mrvn: you want phantom types?
<mrvn>
No. the block for the {} should be tagged.
<det>
type b = A of {a: int} | B of {b: string;}
<det>
let f x =
<det>
match x with
<det>
| A x -> x
<det>
| B x -> x
<det>
I should have named the second x something else, it shadows the first
<mrvn>
det: that code makes no sense in this context
<det>
but it is valid code
<det>
if you could inline record definitions
<mrvn>
det: That depends on the implementation.
<det>
your example does this even
<mrvn>
For the code to be valid A x and x must be synonym and f is then b -> b.
<det>
that is impossible
<det>
I hope my shadowing of x isnt confusing you
<det>
type b = A of {a: int} | B of {b: string;}
<det>
let f x =
<det>
match x with
<det>
| A blah -> blah
<det>
| B foo -> foo
<det>
there
<mrvn>
What else could it be? A x -> x is either b -> b or b -> int and B x -> x is b -> b or b -> string. Only the b -> b would make it valid.
<det>
the type would have to be something that references the namespace and at least 1 field
<det>
and to be as least confusing as possible, the type would need to be the module + full record type
<mrvn>
det: referencing either the constructor (A) or a field (a) would allow the type to be infered.
<det>
but what would the type look like ?
<det>
sorry
<det>
you are right
<mrvn>
type b = A of {a: int} | B of {b: string;}
<det>
I can come up with a well typed example though
<mrvn>
or type b = A of a:int * b:float | B of c:char
<mrvn>
The important part would be that the fields are labeled and possibly mutable.
<mrvn>
det: But you are right match b with A x -> (fun x -> x.a) x
<mrvn>
What type has the closure?
<mrvn>
Would ahve to be something like type b.A or so
<det>
type b = A of {a: int} | B of {b: string;}
<det>
let f x c1 c2 =
<det>
match x with
<det>
| A blah -> c1 blah
<det>
| B foo -> c2 foo
<mrvn>
det: give me an example with type b = A of {a: int; b: int} | B of {c: string; d: string}
<det>
the example above works, just substitute my b for yours
<mrvn>
det: no, the constructor expects 2 arguments and you only have one.
<det>
oh right, ocaml constructors have arity
<det>
when you consider that they have arity, I guess you have a good point
<det>
they could be labeled
<mrvn>
But I think A blah and blah shouldn't be equivalent. That doesn't match with type b' = A of int
<mrvn>
you convinced me.
<det>
You could label the fields of constructor, but you'd have to use them when matching too
<det>
I often think of ocaml constructors taking 1 argument, which might be a tuple
<det>
I forget that this isnt true
<mrvn>
saves memory and indirections
<det>
yeah, if your tuples and constructors are both boxed
<mrvn>
I just hate to have type t = A of a * b * c * d * e * f * g * h * i * j. Nobody can remeber what each field is for then. With a record you can put some meaning into the lables and easily access them individually.
<mrvn>
and A of a_record is wastefull.
<det>
I understand now
<det>
I guess Ocaml could be extended to have something like this:
<det>
type b = A of ~a : int * ~b : string | B of ~c : char * ~d : bool
<det>
let f x =
<det>
match x with
<det>
| A(~a=a, ~b=b) -> ...
<det>
| B(~c=c, ~d=d) -> ...
<mrvn>
That is half of it. mutable is the other half.
<mrvn>
The ~a you could do with camlp4 I guess.
<det>
I thought you were talking about extra syntax
<det>
not indirections
<mrvn>
It would be extra syntax to denote that you don't have an idirection here but lables.
<mrvn>
{..} was just an idea.
<mrvn>
~label might be less confusing.
<mrvn>
So back to my other question:
<det>
having uboxed tuples could also work :-)
<mrvn>
How safe is this? type b = B of int * int type b_rec = { x: int; mutable y : int; } let set_y (b : b) y = ((Obj.magic b) : b_rec).y <- y let t = B (1,2) let _ = set_y t 3 let t = t;;
<det>
have you tested it?
<det>
to see if it works at all
<det>
I wouldnt think b and b_rec would have the same implementation
<mrvn>
works so far
<det>
maybe it will break with more constructors
<mrvn>
b is a tuple and b_rec a record. same memory layour.
<det>
b has a tag too
<mrvn>
But in the tag field of the block.
<det>
I see
<mrvn>
`B of int * int would be { hash: value; x: int; y: int } but that is different
<mrvn>
The important part is that b-rec must be private and never constructed. Otherwise the block is missing the tag.
<mrvn>
Or put differently you can't cast a b_rec to b. Only a b to b_rec (and then back)
<mrvn>
And all this is for the normal ocaml. Other compiler could have different memory layout.
<det>
I cant think of any good solution, if you must mutate the insides of constructors
<det>
Obj.magic is scary
<mrvn>
yeah. Messed it up and got segfaults on the first try too.
<det>
I think of this as more of a problem of lacking unboxed tuples
<mrvn>
You get some surprising results with prefix typing and Obj.magic too:
<mrvn>
type a = { a : int; } type b = { b : int; c : int; } let as_a (x : b) = ((Obj.magic x) : a) let a = { a = 1; } let b = { b = 1; c = 1; } let t = a = (as_a b);;
<mrvn>
Without trying what is t?
<det>
you also cant represent an array of tuples without the extra indirection
<det>
with unboxed tuples (and records) you could also eliminate the arity on constructors
<mrvn>
det: If you have an array of tuples without indirection then any reference to one tuple would hold the complete array.
<mrvn>
And you would need a proxy object or the GC crashes.
<det>
it would just hold all elements of the tuple
<mrvn>
det: no. the full block.
<det>
you dont need to GC unboxed things
<mrvn>
You can never ever just hold parts of a block or even a pointer into the middle of a block or the GC explodes.
<det>
you wouldnt have no pointer
<mrvn>
every non primitive type is a pointer
<det>
assuming: let a = [|1,true;2, false; 3,true|]
<det>
a.(0) would load both 1 and true
<mrvn>
let f ((a, b) as t) = x := t; a f a.(0)
<mrvn>
What would that do?
<det>
where do you define x
<mrvn>
globally
<det>
you formatting confuses me
<det>
so many spaces after ; a
<mrvn>
let f ((a, b) as t) = x := t; a;;
<mrvn>
f a.(0)
<mrvn>
Does x then point into the array or does a.(0) allocate a freh touple and copy 1,true into it?
<det>
that would pass 2 values to f (as a tuple, no pointer)
<det>
fresh copy
<det>
but on the stack
<mrvn>
Ok, that would work.
<det>
not heap
<mrvn>
must be heap.
<mrvn>
x can't point to the stack
<det>
it would copy again into x :-)
<mrvn>
That would change the semantic.
<det>
I dont think so
<mrvn>
hmm, tuples are purely functional so copying them doesn't hurt. you are right.
<mrvn>
Do the same with mutable records and it changes things.
<mrvn>
det: figured out yet what t will be in the above?
<det>
sorry
<det>
forgot about it
<det>
first let me format it sanely :-)
<mrvn>
We need an irssi plugin that formats ocaml code. :)
<det>
t is bool ?
<det>
I am guessing not
<det>
and this is the surprise ?
<mrvn>
It is bool. But what value?
<det>
oh
<mrvn>
# a;;
<mrvn>
- : a = {a = 1}
<mrvn>
# as_a b;;
<mrvn>
- : a = {a = 1}
<mrvn>
val t : bool = false
<det>
I dont know how ocaml represents these things
<mrvn>
Both as a block with tag 0.
<mrvn>
The problem is that the ( = ) is polymorphic and compares the raw blocks. And then (as_a b) is still a block of size 2 while a is size 1.
<mrvn>
I was expecting the compiler to generate code that actualy compares two 'a' but it just calls the polymorphic one.
<det>
Ocaml doesnt do anything that fancy :-)
<mrvn>
yeah.
<det>
re: formatting
<det>
I prefer to just paste small examples or use a pastebin for larger
<det>
than format on 1 line
<det>
and I am a big fan of forced indentation/style
<det>
invoke function used in shootout, in original and pythonic syntax
Drk-Sd has joined #ocaml
<mrvn>
Sleepless in Tuebingen watches Sleepless in Seatle.
enthymene is now known as Pyro`
Pyro` is now known as ThePyro
ThePyro is now known as enthymene
catofzen has left #ocaml []
enthymene has quit [Quit: </Ahnuld>]
sepp2k1 has quit [Quit: Leaving.]
Mr_Awesome has joined #ocaml
Drk-Sd has quit [Quit: dodo]
travisbrady has quit [Quit: travisbrady]
rwmjones has quit [Ping timeout: 256 seconds]
valross has joined #ocaml
walrus__ has joined #ocaml
walrus__ has quit [Remote host closed the connection]
_unK has quit [Remote host closed the connection]
enthymene has joined #ocaml
yakischloba has joined #ocaml
yakischloba1 has joined #ocaml
yakischloba has quit [Read error: Connection reset by peer]
ramenboy has joined #ocaml
brooksbp has quit [Remote host closed the connection]
yakischloba1 has quit [Quit: Leaving.]
yakischloba has joined #ocaml
Submarine has joined #ocaml
avsm1 has joined #ocaml
avsm has quit [Ping timeout: 258 seconds]
enthymene is now known as enth|amble
ulfdoz has joined #ocaml
enth|amble is now known as enthymene
avsm has joined #ocaml
avsm1 has quit [Ping timeout: 276 seconds]
ttamttam has joined #ocaml
ulfdoz has quit [Ping timeout: 276 seconds]
Submarine has quit [Read error: Connection reset by peer]
ttamttam has quit [Quit: Leaving.]
avsm has quit [Quit: Leaving.]
joewilliams is now known as joewilliams_away
tmaedaZ has quit [Ping timeout: 246 seconds]
tmaedaZ has joined #ocaml
yakischloba has quit [Quit: Leaving.]
_zack has joined #ocaml
Submarine has joined #ocaml
Yoric has joined #ocaml
ygrek has joined #ocaml
enthymene has quit [Quit: rcirc on GNU Emacs 23.1.1]
spearalot has joined #ocaml
albacker has joined #ocaml
ttamttam has joined #ocaml
_zack has quit [Quit: Leaving.]
f[x] has joined #ocaml
_zack has joined #ocaml
Yoric has quit [Ping timeout: 268 seconds]
_zack has quit [Client Quit]
filz has joined #ocaml
Submarine has quit [Quit: Leaving]
<flux>
mrvn, regarding ``I can do "type a = A of int * int"..'' -> I think the reason is that you can express type int * int inline in ocaml (let a : int * int = 42, 4), but you cannot express record types inline. therefore in expression B x the type of x would not be expressible in ocaml, because it would not have a name either.
<flux>
oh, apparently it was discussed further already, but perhaps this was still a useful POV
_zack has joined #ocaml
<flux>
also I don't see how type a = A of a' and a = { .. } is wasteful. memory-wise? too much to type? too many types?
ygrek has quit [Ping timeout: 245 seconds]
oc13 has joined #ocaml
boscop has joined #ocaml
CcSsNET has joined #ocaml
jcaose has joined #ocaml
Submarine has joined #ocaml
Submarine has quit [Changing host]
Submarine has joined #ocaml
Yoric has joined #ocaml
Yoric has quit [Client Quit]
jao has quit [Ping timeout: 265 seconds]
pimmhogeling has joined #ocaml
th5 has joined #ocaml
ikaros has joined #ocaml
ygrek has joined #ocaml
munga has joined #ocaml
sepp2k has joined #ocaml
rwmjones has joined #ocaml
_unK has joined #ocaml
ikaros has quit [Quit: Leave the magic to Houdini]
<roconnor>
or otherwise stop ocaml top level from truncating my output prematurely
jao has joined #ocaml
<ReachingFarr>
No Menhir users here?
jao has left #ocaml []
albacker has quit [Ping timeout: 276 seconds]
bzzbzz has joined #ocaml
_zack has joined #ocaml
yakischloba has quit [Ping timeout: 248 seconds]
avsm has quit [Quit: Leaving.]
xcthulhu has joined #ocaml
<Camarade_Tux>
roconnor: set_print_depth? never heard about that function or anything like that, and I don't think you have anything like that
<Camarade_Tux>
roconnor: however, using a custom printer should work, but I've never done it
<Camarade_Tux>
ReachingFarr: don't ask to ask but ask
ulfdoz has quit [Ping timeout: 265 seconds]
rhar has joined #ocaml
roconnor has quit [Remote host closed the connection]
_zack has quit [Ping timeout: 265 seconds]
mbishop has quit [Ping timeout: 265 seconds]
yakischloba has joined #ocaml
mbishop has joined #ocaml
dark has joined #ocaml
ramenboy has joined #ocaml
brooksbp has quit [Quit: Leaving...]
avsm has joined #ocaml
<ReachingFarr>
Wasn't asking to ask, was asking if there was even a point to me asking. If no one knows about Meinher there really isn't any point in me waiting around to see if anyone answers.
sepp2k has joined #ocaml
Amorphous has quit [Read error: Operation timed out]
enthymene has quit [Quit: rcirc on GNU Emacs 23.1.1]