<confound>
so, http://code.google.com/p/deriving/wiki/Introduction looks really neat, but I think it's assuming some knowledge that I don't have. how do I actually apply it to my code? right now I'm just doing `ocamlfind opt -linkpkg -package foo,bar,baz -o myprog myprog.ml`
willb1 has quit [Read error: Operation timed out]
myu2 has quit [Read error: No route to host]
myu2 has joined #ocaml
csong has joined #ocaml
csong is now known as lars9
<lars9>
hi im a haskeller and learning ocaml now
<lars9>
i have a question about type definition
<lars9>
is the _elem_ in 'a elem a type constructor?
<thelema>
lars9: yes
<thelema>
confound: add "-syntax camlp4o" to that line to enable any camlp4
<lars9>
thelema: can it have multiple type variables?
<lars9>
like 'a 'b 'c tuple3
<thelema>
lars9: yes, as a tuple
<thelema>
type ('a, 'b, 'c) tuple3 = 'a * 'b * 'c
<lars9>
so it's just like type Tuple3 a b c = (a, b, c) ?
<lars9>
haskell put type constructor left most, and ocaml right most?
<confound>
thelema: deriving doesn't have a META file, so ocamlfind gives me an error about setting 'preprocessor'
<confound>
(which I have no clue about)
<thelema>
confound: ah, well then...
<thelema>
lars9: yes, opposite order
<lars9>
thelema: thanks
<lars9>
how to use open Core.Std in toplevel?
<thelema>
lars9: probably something like: #use "topfind";; #require "core";; (or whatever the core ocamlfind module is named)
<thelema>
confound: wow, you're right. Why wouldn't it have a META file...
willb1 has joined #ocaml
<lars9>
when defining a record type. what is the _with_ in type t = {x:int; y:int;} with abc;; ?
<thelema>
? I didn't realize that was valid syntax
<thelema>
there's with syntax for records: type r = {a:int; b:int} let r1 = {a=2;b=3} in {r1 with b=2}
<gildor>
thelema: documentation task cannot be part of it
<flux>
GSoD :)
<thelema>
gildor: ah, no problem
<gildor>
thelema: sorry for that
<thelema>
I wasn't thinking just to document ocaml, but to update the document generation routines
<gildor>
I think you can defend your case for the document generation routines
<thelema>
The default output of ocamldoc is not very nice. Yoric had an improved document generation which got dropped
<gildor>
but the survey (with this title) cannot make it
<thelema>
I'll see if can work on the specifics of what to do before putting that up.
<gildor>
and "Improve documentation generation" -> Enhance ocamldoc plugin to render documentation is probably better (sound more like a programming project?)
<thelema>
sure. I guess shortening it too much took away from the intent
<thelema>
I wonder if coming up with good example code for every batteries function would be a programming project or a documentation project
<gildor>
don't know
<thelema>
just a thought.
<kaustuv>
isn't "torture" usually something HR handles?
ygrek has quit [Ping timeout: 240 seconds]
avsm has quit [Quit: Leaving.]
<thelema>
kaustuv: :) I think maybe the inline test cases could be used for documentation as well, as often they show example usage and the proper result
<thelema>
scripting that into the batteries build system would be a proper programming task
tauntaun has quit [Ping timeout: 240 seconds]
<thelema>
hmm, massif (from valgrind) insists I've got 1.5GB in my heap, while I'm fairly certain I'm reading a directory with < 1GB of data, parsing it and returning just a BatVect with the parsed sections that total 0.7GB
<thelema>
I can't imagine that the overhead on the vect is 100%, considering it's only got 500K elements
<thelema>
Valgrind reports 974MB of heap allocated by caml_alloc_string and 494GB by caml_oldify_one -- does anyone know what this second function is?
<thelema>
it seems related to moving data from the minor heap to the major heap
<kaustuv>
Exactly. It promotes one object and updates all pointers to it
sepp2k has quit [Read error: Operation timed out]
<mrvn>
and while it promotes you have twice the memory usage.
<adrien>
thelema: you can probably try lowering GC.space_overhead
sepp2k has joined #ocaml
<orbitz>
ahhh
* orbitz
is still battlign tuareg-mode
ikaros has joined #ocaml
lopex has quit []
ccasin has joined #ocaml
agarwal1975 has joined #ocaml
Yoric has joined #ocaml
ccasin has quit [Quit: leaving]
ccasin has joined #ocaml
enthymeme has joined #ocaml
lopex has joined #ocaml
ccasin has quit [Quit: leaving]
ccasin has joined #ocaml
ccasin has quit [Client Quit]
ccasin has joined #ocaml
<thelema>
kaustuv: so memory allocated by oldify_one has been promoted from the minor heap... now I just have to figure out how I have so much data promoted
<thelema>
adrien: I drop space_overhead to 0 when I read the files in, as I'm allocating a single string for the whole file.
<thelema>
mrvn: sure, but I'm experiencing twice the expected memory usage for more than just a short time - the memory usage stays at 1.5GB for a file that's half that size
eye-scuzzy has quit [Quit: leaving]
eye-scuzzy has joined #ocaml
ygrek has joined #ocaml
<hcarty>
thelema: Does a Gc.full_major affect memory use at all, once everything is loaded?
<thelema>
no
<thelema>
so clearly the answer is that I'm leaking something
<mrvn>
The heap is allocated in bigger chunks. Some overhead is expected.
<thelema>
even when I Gc.compact()?
<mrvn>
Does valgrind complain about unfreed memory when you quit?
<mrvn>
thelema: sure. The heap still remains allocated. It just has a solid free chunk at the end for future use.
<thelema>
hmm... I'm pretty sure I've caught ocaml giving memory back to the OS when I compact
<thelema>
massif complains about bad stack frames and valgrind complains about unfreed memory, but I expect the second
<mrvn>
I think it will give memory back if a whole chunk is free. But I don't think it ever shrinks a chunk.
<thelema>
if I compact, shouldn't there be a ton of free chunks?
<mrvn>
thelema: There aren't many chunks to begin with.
<mrvn>
I wouldn't expect it to shrink the heap unless it is <50% full or something.
ccasin has quit [Quit: leaving]
ccasin has joined #ocaml
<thelema>
my heap increment is the default, shouldn't that keep the granularity small?
ccasin has quit [Client Quit]
ccasin has joined #ocaml
<mrvn>
what is the default? factor 2? 1.5? golden ratio?
ccasin has quit [Client Quit]
ccasin has joined #ocaml
<thelema>
isn't it a fixed amount - default 126k words?
<thelema>
124k
<thelema>
well, I guess that's the "minimum", so maybe it does grow faster than I expect
ccasin has quit [Client Quit]
ccasin has joined #ocaml
ccasin has quit [Client Quit]
<thelema>
and in another run, linux reports 2.9GB allocated, while the GC counts only 1.6GB in live words - I guess it's possible that the last chunk allocated is bigger than that difference
ccasin has joined #ocaml
ccasin has quit [Remote host closed the connection]
ccasin has joined #ocaml
<mrvn>
turn up the verbosity of the gc and it will tell you
ccasin_ has joined #ocaml
DimitryKakadu has joined #ocaml
ccasin has quit [Client Quit]
ccasin_ has left #ocaml []
kaustuv_ has joined #ocaml
<kaustuv_>
agarwal1975: why is it Tuple5.fvth and not Tuple5.ffth?
<agarwal1975>
no good reason.
<agarwal1975>
i can change it.
<agarwal1975>
alternatively, I was wondering if we should just use full words: first, second, third, etc.
<agarwal1975>
these names have a different meaning in the current Pair, to mean map the 1st, 2nd, etc item, but those are being deleted anyway.
<kaustuv_>
I would vote for full words
<agarwal1975>
me too actually.
<agarwal1975>
of course fst and snd would still be available in Pervasives.
<agarwal1975>
The current Pair.first and Pair.second have been renamed to map1 and map2, which I think is much more intuitive.
<agarwal1975>
should I just do it? I guess I'm not sure of what kind of consensus is req'd. or should I email the dev list, asking people to vote?
<kaustuv_>
You can e-mail the list, but I suspect the response will be "just do it". /cast summon thelema
ygrek has quit [Ping timeout: 240 seconds]
* thelema
appears
<thelema>
well, at least the signatures are different, so I'll get build errors when we migrate to the new names
Cyanure has joined #ocaml
<thelema>
agarwal1975: I'm fine with either abbreviations or whole words. if others have a preference, now's the time to get it changed, before we release 1.4
<thelema>
if you want to change them now, I'm fine with it.
<mrvn>
fvth and ffth are incomprehensible. use words.
<agarwal1975>
looks like we have consensus. :)
<adrien>
(optic) fiber for the home?
<thelema>
_5th?
<mrvn>
first, second, third, nth
<agarwal1975>
agarwal1975: interesting, had not thought of that. not sure i like it.
yezariaely has joined #ocaml
<adrien>
=)
<agarwal1975>
mrvn: by nth do you mean, etc. or does that do something itself.
<mrvn>
agarwal1975: List.nth 5 list
<thelema>
mrvn: can't type nth for tuples
<agarwal1975>
but that would not be type safe, what if you pass 6 on a 5-tuple.
<thelema>
mrvn: Tuple5.nth 3
<thelema>
I guess it could raise an exception
<thelema>
match n with 1 -> a | 2 -> b | 3 -> c | 4 -> d | 5 -> e | _ -> failwith ...
<thelema>
it'd only work on ('a,'a,'a,'a,'a) tuples, though
<agarwal1975>
yes, I suppose it could be useful for tuples where all items are of the same type. would be easier to iterate over all items.
<mrvn>
thelema: Obj.field ...
<agarwal1975>
but you already get that by converting to enum..
<thelema>
mrvn: eep!
<mrvn>
but yeah, only works on tuples of same type.
<mrvn>
nth for tuples probably doesn't make sense. but other modules should have the same first/second/third and also nth.
ccasin has joined #ocaml
<agarwal1975>
mrvn: what other modules would need first, second, etc.
<thelema>
mrvn: Map.nth?
<thelema>
mrvn: Heap.nth?
<mrvn>
List, Array, Queue?
<thelema>
I guess anything that can be enum'ed can be nth'ed
<mrvn>
yes
<agarwal1975>
mrvn: so you want List.second? I don't see the benefit.
<mrvn>
agarwal1975: if more than just tuples have it then everything enumerable should have it
<mrvn>
for consistencies sake.
<agarwal1975>
but it is only tuples that have first, second, ...
<kaustuv_>
consistency in ocaml?! over my dead body!
Yoric has quit [Quit: Yoric]
<mrvn>
I've needed it for lists and queues in the past
<thelema>
batteries has it for lists, and likely for queues
<agarwal1975>
just first, but not second, third.
<thelema>
I'm a fan of the pop function I've added to maps and sets
<thelema>
but I was more referring to nth
<agarwal1975>
anyone here familiar with PG'OCaml? I'm stuck installing it.
<kaustuv_>
module AddOrdinals (M : sig type 'a t val nth : 'a t -> int -> 'a end) = struct let second m = M.nth m 2 (* etc *) end ?
<agarwal1975>
docs for BatList.nth say "Obsolete. As at."
<thelema>
apparently "at" is the new way to say "nth"
<hcarty>
thelema: Bat(Map|Set).pop does not seem to be ordered. Is that correct?
<kaustuv_>
I think "nth" was a much better name
<thelema>
kaustuv_: if you assume enumerable, you get nth
<thelema>
hcarty: yes, very
<thelema>
hcarty: I expect it to do as little work as possible to get the one element
<thelema>
which means taking the root of the tree
<agarwal1975>
kaustuv_: yeah, kind of agree. I like nth.
<thelema>
I'm neutral, put it to the batteries list.
<thelema>
at is slightly shorter, and List.at 3 reads a little better than List.nth 3
<kaustuv_>
except it's List.at l 3, which seems to mean (in English at least) that 3 is "at" l.
<thelema>
hmm, that's not so nice.
<mrvn>
for me at means direct access while nth means having to read past the leading ones.
<thelema>
why is it backwards...
<kaustuv_>
curryability
<thelema>
arguable - I can imagine partial applying the position more than the list
<thelema>
we should get more named parameters
yezariaely has left #ocaml []
<thelema>
except I don't think ocaml is as friendly as I thought about named parameters
<thelema>
maybe it's only optional parameters - I just had some problems with BatString.slice
<kaustuv_>
Yes, I wish there was some way to tell OCaml to not automatically turn (f x y) to (f ~arg1:x ~arg2:y)
<thelema>
# String.slice 1 3 "abcdefghi";;
<thelema>
# Error: The function applied to this argument has type ?first:int -> ?last:int -> string
<thelema>
maybe it's because the mixture of named and unnamed
<mrvn>
There must be a reson stdlib has labeled and unlabeled flavours
<kaustuv_>
the reasons might have to do with the merger of O'labl and O'Caml
<mrvn>
thelema: they are optional. 1 can be first or last
<thelema>
but it's a complete application, doesn't that match things positionally?
<thelema>
I guess not.
<kaustuv_>
only for non-optional labels, iirc
<mrvn>
What should String.slice 1 "abcdefghi";; do?
philtor has joined #ocaml
<mrvn>
or (String.slice 1)? With optional args the application is ambigious.
<thelema>
sure, but if the application is complete...
<mrvn>
I don't think the compiler looks that far ahead
<thelema>
mrvn: it does for non-optional labels
<mrvn>
I think optional args must simply always be specified by label.
<thelema>
I guess the arity of functions without optional arguments is known ahead of time
<thelema>
so the compiler can detect complete application... although the max arity of functions with optional args should also be known
<kaustuv_>
Well, "arity" is a mysterious concept in ML-like languages anyway. (Think printf)
<mrvn>
thelema: the compiler doesn't need complete application. It just applied the next arg
<thelema>
the compiler does optimize complete application, so it has code to detect it
<mrvn>
kaustuv_: printf is a seriouis hack though.
<thelema>
kaustuv_: true. an impressive hack.
<kaustuv_>
Not really. I can write printf using non-hacky OCaml using combinators
<mrvn>
or rather the format string.
<thelema>
kaustuv_: not without objectionable syntax or syntax mangling
<thelema>
s/syntax mangling/code filters/
<kaustuv_>
The point is, you can never tell if (f x y) is a complete application knowing just the type of f.
<mrvn>
kaustuv_: sure you can.
<thelema>
for non-polymorphic f, yes
<kaustuv_>
mrvn: is (id id) a complete application?
<mrvn>
sure. id takes ONE argument and you have given it one.
<kaustuv_>
But by that token every function takes one argument
<thelema>
kaustuv_: arity = maximum tuple size when curried
<mrvn>
kaustuv_: In ocaml that is actually true since everything is curried.
<thelema>
err, uncurried
<kaustuv_>
the point is functions that have a polymorphic return type don't have a "maximum tuple size"
<mrvn>
But for the sake of making sense fun x y -> ... and function x -> function y -> have different arity imho.
<thelema>
mrvn: only if there's code before the function y
<thelema>
although going there is not pretty
<mrvn>
thelema: really? Does ocaml combine the function's?
<thelema>
no, it uncombines the fun x y into function x -> function y ->
<flux>
whoa, lots of stuff has updated [in batteries] since I've last git pulled :)
<kaustuv_>
I think it is better to think of "arity" in languages with parametric polymorphism as a "may" rather than a "must" specification. In that sense, (+) does not have arity 3, but id has any arity.
<thelema>
flux: we've been hard at work
yuvi_ has joined #ocaml
yuvi_ has quit [Read error: Connection reset by peer]
ymasory_ has joined #ocaml
<thelema>
kaustuv_: I'm not comfortable giving id any arity, it's clearly arity 1, despite that the result of applying it to a value can be a function
<thelema>
it's got one arrow in its definition
<mrvn>
kaustuv_: I think of arity as the number of arguments the function is ment to take before it gives a result. id takes one. + takes 2.
<thelema>
(maybe that's a better definition of arity)
<mrvn>
The result can be a function again but id clearly is ment to work on one argument.
<kaustuv_>
How about (failwith "foo")? It has *no* arrows in its (most general) type. Does that mean it has arity 0?
<thelema>
kaustuv_: yes, arity 0. no problem.
<kaustuv_>
So an arity 0 entity can be a function too? You have no problem with this?
<mrvn>
failwith "foo" doesn't have a result, it just throws an exception
<mrvn>
kaustuv_: arity 0 describes a value.
<thelema>
a polymorphic arity 0 entity can't be anything.
<kaustuv_>
id *is* a value
<mrvn>
kaustuv_: a non functional value
<mrvn>
thelema: how do you get a polymorphic arity 0 entity?
<kaustuv_>
"non functional" ain't a well formed concept when you have ML's full generality.
<thelema>
mrvn: (failwith "foo") is type 'a, polymorphic arity 0
<kaustuv_>
For example, is 'a Parser.t a non-functional value? How can you know without breaking the abstraction?
<mrvn>
thelema: but you can't use it since it doesn't produce that value.
ftrvxmtrx has quit [Quit: Leaving]
<mrvn>
kaustuv_: for all intents outside the module it is not a function.
<mrvn>
Lets define arity as the minimum number of arguments you need to apply to a function so it returns :)
ulfdoz has joined #ocaml
<kaustuv_>
let rec f x = f x. What is it's arity?
<kaustuv_>
s/it's/its/
<mrvn>
indetermined
<thelema>
kaustuv_: I'd say one. despite being 'a -> 'b (because it doesn't return), it's still arity 1
<mrvn>
I agree but the definition wouldn't give that
<thelema>
its evaluation causes some work (other than producing a closure, waiting for more arguments) to be done when a single parameter is passed
<kaustuv_>
I would say that you are both proposing a notion of "arity" that is not parametric in the same sense as polymorphism is parametric. And that is generally a sign that it's a broken concept.
<mrvn>
kaustuv_: if you include polymorphism then any interesting function has variable arity.
<kaustuv_>
Indeed. The whole reason we have the caml_curry/caml_uncurry mess is because of "variable arity"
<kaustuv_>
By the way, I think Scala gets arity right with its (t1, t2, ..., tn) => t types
<kaustuv_>
(it may be -> instead of =>, I forget)
<mrvn>
One could also define the arity as the number of arguments ocaml combines into a closure call. I.e. how many args it takes before it computes something.
Cyanure has quit [Quit: Quitte]
<thelema>
mrvn: computes something other than just the closure waiting for the next argument
<mrvn>
thelema: yes.
<mrvn>
computes some of the user specified source code.
<mrvn>
let f = function x -> incr foo; function y -> x + y would have arity 1.
<mrvn>
let f x = let t = x in function y -> t + y => 1
<mrvn>
although that is an odd case
ymasory_ has quit [Quit: Leaving]
ymasory has quit [Remote host closed the connection]
ymasory has joined #ocaml
<flux>
thelema, hm, unicode or latin1 in Batteries source files?
<mrvn>
ascii
<mrvn>
only way that works everywhere :)
<kaustuv_>
OCaml's own source code doesn't live by your strict rules
<flux>
well, my surname doesn't work in ascii :)
<mrvn>
kaustuv_: because its french. :)
<thelema>
flux: technically everything is latin1, but some of that latin1 happens to represent useful utf8
<kaustuv_>
ps, ascii doesn't work everywhere, though I am not sure if OCaml has been ported to any ebcdic platforms
<mrvn>
kaustuv_: die die die. :)
Snark has quit [Quit: Ex-Chat]
<_habnabit>
flux, sadly, you can't put unicode in files.