flux changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | 3.11.0 out now! Get yours from http://caml.inria.fr/ocaml/release.html
hkBst has joined #ocaml
seafood has quit [Read error: 145 (Connection timed out)]
seafood has joined #ocaml
psnively has quit []
prime2 has joined #ocaml
Fullma` has joined #ocaml
jonafan has quit ["Leaving"]
Fullma has quit [Nick collision from services.]
seafood has quit [Read error: 104 (Connection reset by peer)]
seafood has joined #ocaml
love-pingoo has quit ["Connection reset by pear"]
willb has quit [Read error: 110 (Connection timed out)]
<alexyk> how do you mac folks configure conf-tcltk in godi?
<alexyk> huh -- conf-tcltk doesn't expect version 8.5?! up to 8.4 only...
seafood has quit [Connection reset by peer]
jonafan_ has joined #ocaml
jonafan_ is now known as JONAFAN
JONAFAN is now known as jonafan
vuln has joined #ocaml
el_ermitanio has joined #ocaml
seafood has joined #ocaml
<kaustuv> ML for the working programmer is one of the best programming books ever written for a dead language.
<bjorkintosh> what's the dead language?
<kaustuv> Standard ML
<bjorkintosh> sml is dead?
<bjorkintosh> since when?
<kaustuv> Since 1997 when the language was chiseled into stone for ever and ever.
<thelema> yes, that would be a pretty good indication of a dead language. You've got to grow and evolve to stay alive
<thelema> Even Ada, the "built-by-committee" language, still evolves (Ada2005)
<bjorkintosh> pfft. name a language no longer built by committee and i'll show you an infant language.
<thelema> I did say wrong - I meant "designed by committee"
<thelema> and as much as the community is getting involved in perl, python and ruby, they still each have their own benevolent dictator at the helm.
angerman has joined #ocaml
angerman_ has joined #ocaml
el_ermitanio is now known as maxote
<bjorkintosh> ada had a benevolent dictator for a little while.
<bjorkintosh> ... the DoD :D
<thelema> DoD does dictate, but it's not a single person to keep the language with a single flavor.
<thelema> btw, who here considers OCaml a declarative language?
<mbishop> DoD has nothing to do with Ada anymore
<thelema> they ran out of Ada programmers, and needed to cut costs, so are hiring cheaper, mainstream programmers
<kaustuv> What do you mean by declarative language? Generally one contrasts declarative *style* with other styles, not languages.
<bjorkintosh> i'm sure he meant declarative vs imperative etc
<kaustuv> again, those are styles, not inherent to a language. Haskell can be written in an imperative style, for example, if you live inside the IO monad.
angerman has quit [Connection timed out]
<thelema> well,
<thelema> The claim is that OCaml is declarative because you can extend its syntax or create sublanguages (camlp4, I guess) and because some libraries modify the language
<kaustuv> That's true, but irrelevant. Obviously you can embed cut-free Prolog as a DSL in OCaml and then write declarative predicates for the rest of eternity. The claim is almost like saying that OCaml is an untyped programming language because you can write a Scheme interpreter in it.
prime2 has quit [Read error: 110 (Connection timed out)]
angerman_ is now known as angerman
alexyk has quit []
hkBst has quit [Remote closed the connection]
Fullma has joined #ocaml
Fullma` has quit [Read error: 60 (Operation timed out)]
ched_ has joined #ocaml
Ched has quit [Read error: 110 (Connection timed out)]
^authentic has joined #ocaml
authentic has quit [Read error: 60 (Operation timed out)]
^authentic is now known as authentic
seafood has quit [Read error: 104 (Connection reset by peer)]
seafood has joined #ocaml
<bjorkintosh> for such a large channel, there's an unusual number of lurkers.
<bjorkintosh> its vewy quiet. are we hunting wabbit?
seafood has quit []
<thelema> there's always been lots of lurkers here.
<bjorkintosh> yeah but what're they waiting for?
<thelema> interesting conversation?
<m3ga> we is stealing all ur code!!!
<bjorkintosh> right. by lurking they contribute nasink!
<m3ga> i answer the ocassion question here, but don't even lurk that often
<bjorkintosh> do you use the language at all?
M36KTR_JKT has joined #ocaml
M36KTR_JKT has left #ocaml []
<m3ga> also do C, C++ and Haskell
<bjorkintosh> mega nerd? you must me a nerd of some sort.
<m3ga> m3ga!
seafood has joined #ocaml
<bjorkintosh> is it difficult to distinguish haskell from *ml?
<m3ga> yep, my mind has trained itself to switch langauges pretty seamlessly
<thelema> bjorkintosh: no, it's not difficult to distinguish - syntax has some strong differences.
<bjorkintosh> to my untrained eye, it all looks rather similar.
<m3ga> i did 4 years of ocaml before taking up haskell
<m3ga> while I was starting ocaml i was also coding on python
<thelema> it's not c-style with lots of {}, but function definitions look quite different - pattern matching vs. multiple definitions for different cases
seafood has quit [Read error: 104 (Connection reset by peer)]
seafood has joined #ocaml
<m3ga> i like haskell's significant whitespace thing, reduced usage of 'let', reduced semicolons and typeclasses
<thelema> everyone likes typeclasses, I think.
<bjorkintosh> really?
<bjorkintosh> including MLers? is it in ml?
<thelema> I dunno about haskell's whitespace thing, but if you want such in ocaml, you can have it: http://people.csail.mit.edu/mikelin/ocaml+twt/
<thelema> bjorkintosh: no, it's not in ML, not even OCaml.
<thelema> It's a nice feature, and people are constantly wishing OCaml had it.
<bjorkintosh> people are always wishing for ml's modules.
<bjorkintosh> i don't know what they are yet though.
<thelema> ML's modules are "very nice"
<m3ga> bjorkintosh: ocaml doesn't have typeclasses and i believe that they can't addded becaus eof soemthing already in the ocaml typesystem
<bjorkintosh> ah.
<thelema> ocaml won't do overloading, and typeclasses basically do overloading.
<bjorkintosh> i just got two books in the mail ...'the haskell road to logic ... etc' and 'the little mler'.
vuln has quit ["leaving"]
seafood has quit [Read error: 104 (Connection reset by peer)]
<bjorkintosh> i might learn a thing or two about either language after i read the books.
<m3ga> you learn the languages by coding as soon as possible :-)
tonyIII__ has joined #ocaml
<thelema> One learns to ride a bicycle by... riding a bicycle. Learning to swim involves... swimming a lot. Learning a language requires... using that language.
<bjorkintosh> yeah. doing the exercises etc.
tonyIII_ has quit [Connection reset by peer]
gaze__ has quit []
gaze__ has joined #ocaml
alexyk has joined #ocaml
m3ga has quit ["disappearing into the sunset"]
<alexyk> anyone tried to install lablgl on a mac lately?
<alexyk> it gives me flowers in Togl
<alexyk> and scanning up -- who was Ada's BDFL, Ichbiah?
<alexyk> um, it's way up...
<alexyk> the hexagon and the Atlantic are asleep
angerman has quit []
ttamttam has joined #ocaml
Charlie`` has joined #ocaml
<Charlie``> Anyone have a minute? I'm having a hard time developing a function that can take a list of pairs and generate a list of nodes (vertices) from those. All my experience is with imperative programming and I'm trying to look at this from a functional perspective.
<kaustuv> What is a node? The first element of a pair?
<Charlie``> Well a node of a directed graph. My approach is to have a recursive function to put all first elements of the pair in a list. Then to go over that list and find any that occur more than once and reproduce a new list of those.
<Charlie``> But I'm not really sure how to generate that new list, or if that is even the best way to go about it.
_zack has joined #ocaml
<Charlie``> For example, given as input [(1, 2); (1, 3); (1, 4); (2, 3); (3, 5); (2, 4)] the function should reproduce [1;2]
angerman has joined #ocaml
<mrvn> why not 3?
<Charlie``> 3 has nothing else that its paired with
<mrvn> (3, 5)
<Charlie``> besides (3, 5)
<Charlie``> err
<mrvn> is the input sorted?
<Charlie``> I'm stupid
<Charlie``> Sorry, all I am looking for is to produce a list based on the first elements of each pair eliminating doubles
<Charlie``> so for that example it would be [1;2;3]
<Charlie``> and no it does not have to be sorted
<Charlie``> I guess I'm looking for a way to eliminate doubles in a list when they could be located anywhere in the list.
<mrvn> make a set
<Charlie``> What do you mean?
ttamttam has left #ocaml []
<Charlie``> You mean create a set from the list then create a list from the set?
<mrvn> yep
<mrvn> or work with sets in the first place
<Charlie``> I'm given a list I have no choice. I will learn how to use sets. Thank you for the advice.
<mrvn> or an array if you know the number of nodes
<mrvn> or hashtbl.
<mrvn> kaustuv: I would have used if ... then ns else l::ns
<mrvn> and maybe pull the S.add into the if as well.
<mrvn> let (ns, seen) = if S.mem l seen then (ns, seen) else (l::ns, S.add l seen) in
<kaustuv> Premature optimisation is the root of all evil, but yeah.
<kaustuv> mrvn: did you see my comment about diets earlier?
<mrvn> looking for specs now. thx
<Charlie``> kaustuv: seems that code will get rid of doubles but includes the 2nd part of the pair in the list.
<kaustuv> Comment bits out as necessary.
<kaustuv> anything to do with r, in this case
<Charlie``> I have, and then it only reports 1
<Charlie``> instead of 1,2,3 which is weird
<kaustuv> also comment out the S.add r bit
<Charlie``> oh ok
<kaustuv> "seen" is a set that keeps track of what nodes have been inserted into "ns"
<kaustuv> and it's only because sets in the standard lib don't have a to_list
<kaustuv> otherwise you'd use just sets, like mrvn said
<Charlie``> I understand. Thank you
<mrvn> kaustuv: The description of a DIET looks right but the sample implementations are to simplistic.
<kaustuv> yeah, you'd have to do something clever about placing stuff in the nodes and splitting intervals if the stuffs are different/combining if they are the same.
<kaustuv> but it has O(log n) (where n is the number of intervals) lookup and insertion, as you wanted
<kaustuv> (assuming you keep the tree balanced)
<mrvn> The hard part is when I have (2-3, 1) (5-6, 1) and I insert (4-4,1). Normaly I would ind (2-3,1) and change that to (2-4,1). But how do I merge the (5-6,1) in as well?
Charlie`` has quit []
<mrvn> s/ind/find/
<mrvn> And yes, rebalance on the way back up.
<kaustuv> take the simple case of (2-3,1) as the left child of (5-6,1)
<kaustuv> add (4-4,1) is added as the right child of (2-3,1)
<kaustuv> then check with parent and coalesce to (2-4,1)
<kaustuv> check with parent again and coalesce to (2-6,1)
<mrvn> kaustuv: 2-3 might be the rightmost child of a big tree and 5-6 the leftmost of the other child.
<mrvn> could even be on the left and right side of the root node.
<kaustuv> you'd have to do the coalescing along one inorder arc starting from the added child, I guess
<mrvn> Simplest approach I've come up yet is to use a retry technice. Insert the new value looking for an interval <= the value. If it can be merged then remove the old value and repair the tree as you go back. Then insert the merged interval looking for >= the end of the value and either insert or merge it.
alexyk has quit []
<kaustuv> take a look at the last paragraph of page 2 of the diets for fat sets paper
<mrvn> web.engr.oregonstate.edu/~erwig/diet/?
alexyk has joined #ocaml
_zack has quit ["Leaving."]
<mrvn> kaustuv: I have to add balancing to that.
<kaustuv> Make sure that you reall need balancing first. In systemy things you can usually get away with splay trees.
<mrvn> I will create the tree from disk, use it for a while and then store it on disk. If I create it balanced then that is probably enough.
<mrvn> Or i could set a flag when I reach 2*log(n) height and then remake the tree.
<kaustuv> It's a pity that the ocaml runtime isn't multi-threaded, because your task is io-bound so you'll have gobs of spare cycles to twiddle data.
<mrvn> kaustuv: Maybe I'm looking at it the wrong way. I have a HUGE array of reference counts for disk blocks. Most commonly the count is between 0 and 4. So I thought I would encode that as intervals of equal value.
ttamttam has joined #ocaml
<kaustuv> How dense are the elements with non-zero refcounts? Because another option (much simpler) is to use a radix tree
<mrvn> The case where they are not dense it uninteresting.
<mrvn> I would think 99% are != 0 for me.
<kaustuv> how about the sets with refcount 0, 1, 2, 3 and 4. Are they individually sparse?
<mrvn> Depends on fragmentation.
<mrvn> counts 2,3,4,... will be verry rare I think.
seafood has joined #ocaml
<kaustuv> So your densest set is for counts of 1? In that case, keep a Patricia tree for the non-1 nodes.
<mrvn> 0 or 1. It is for a filesystem so it starts out empty and then fills up.
<kaustuv> If you have memory to burn during initialization, make two Patricia trees for non-0 and non-1 counts. Then keep the smaller one.
<mrvn> kaustuv: And 1% zeroes is still 16106127 nodes for my current disk size.
<mrvn> Currently I would have 10% free.
<mrvn> Even a sparse set is huge.
sbok has quit [Read error: 60 (Operation timed out)]
<kaustuv> Bit vectors for 0 and 1 count nodes and some other data structure for the rest? (Make "rest" by setting the bit in both 0 and 1 vectors, eg.)
<mrvn> I'm pretty sure the only reasonable thing is to use intervals in some way.
<mrvn> kaustuv: That would be a 256MB bit vector.
<kaustuv> Have you asked your friendly neighbourhood file systems guru?
<mrvn> kaustuv: hehe. ext2/3 uses bitmaps, xfs/btrfs/zfs uses extends
alexyk has quit []
sbok has joined #ocaml
<kaustuv> Well, a balanced diet is good for you anyhow.
<mrvn> extended to (min, max, count), balanced and with incr/decr function instead of insert/delete.
m3ga has joined #ocaml
<kaustuv> Apropos of nothing, this is the best data structure ever. http://www.itl.nist.gov/div897/sqg/dads/HTML/compactDAWG.html
<kaustuv> I should submit this to proggit as a variation of the yo dawg meme.
<mrvn> Wow. Creating an optimal one mustbe hard.
verte has joined #ocaml
<mrvn> I think I will balance the tree by interval size. At each node the middle value of the interval the subtree covers will be in the interval in the root.
<kaustuv> I think you should still consider separate diets for the 0 and 1 nodes and Patricia trees for the rest, especially if the rest are sparse and noisy. But do it after your current attempt to balance diets, which you'll need anyway, if you observe it taking up a lot of space because of noisy non-{0,1} nodes.
<mrvn> I need to lookup the count for a block, increment or decrement it. With seperate structures I need to search each and always do an delete and insert to change a count.
<kaustuv> Yes, obviously it's O(n) more work, where n is the number of data structures. But the idea is that a random non-{0,1} node won't split an interval.
<mrvn> I intend to allocate blocks sequentialy. So it would always chop of the first block of a 0 interval and change it to 1.
<mrvn> Then some blocks, get more ref so they grow to 2,3,4. Or they loose some refs and drop maybe to 0.
<mrvn> And it should be a good while till the allocation reaches the end and starts from the begining again.
_zack has joined #ocaml
<kaustuv> Well, I have to go earn my paycheque now, so best of luck.
<mrvn> me too.
<mrvn> +-10 minutes
jknick has quit ["leaving"]
nuncanada has quit [Remote closed the connection]
Associat0r has joined #ocaml
fbvortex has joined #ocaml
<fbvortex> Is there a way to create immutable arrays?
<mrvn> functional array or a const array?
<fbvortex> mrvn: sorry, I'm not following you. I want to create a structure that has O(1) random access time to an arbitrary element, like the built-in Array type, but I don't want an Array I declare in the module's namespace to be mutably accessed by any function within the module, just immutably accessed. So like a const Array.
chickenzilla has joined #ocaml
<mrvn> Write a module that just has the immutable functions of Array.
<fbvortex> not sure what you would mean by "functional array"
<mrvn> fbvortex: a function array would be one where when you change a value you get a new array.
<mrvn> +al
<fbvortex> mrvn: isn't that (making my own array module) reinventing the wheel? there's no way to use the standard array in the manner I'm describing (or to annotate it as const somehow)?
<mrvn> fbvortex: don't reinvent anything. Just reuse. In your module you write let init = Array.init let get = Array.get
<kaustuv> module ImmutableArray = struct include Array let set _ = failwith "sorry, can't set" end
<mrvn> kaustuv: bah. I wouldn't even have a set binding then.
<mrvn> but you code is probably less to type
<kaustuv> also extensible across arbitrary library extensions
<fbvortex> hm, seems odd to have to create my own module for this.
<mrvn> I'm missing a const attribute too.
<kaustuv> Actually, my version just doesn't work because the type 'a array is exposed. You'd have to make it abstract in the signature to guarantee immutability
seafood has quit []
tonyIII__ has quit [Connection timed out]
tonyIII__ has joined #ocaml
<fbvortex> as much as I loathe languages like C++, at least there I can just qualify a variable as const. argh. it feels stupid "rolling my own" module when this would clearly be of significant utility to many other using the language.
<tsuyoshi> creating a module is not hard
<fbvortex> tsuyoshi: I know it's not hard, but it also seems absurd not to be generally available.
<fbvortex> are the built-in syntactical pieces such as the [| |] notation for arrays defined in the array module, or are they part of the lower-level implementation?
Yoric[DT] has joined #ocaml
<kaustuv> fbvortex: they are part of the OCaml grammar
<tsuyoshi> except that .() and .() <- get converted to Array.get and Array.set
<tsuyoshi> so if you want to be weird... you can do things like
<kaustuv> Also, the OCaml standard library is deficient in many ways. It is designed to be just enough to write the OCaml compiler. There is a community effort to build a better, more modern standard library, and it might well have arrays without set.
<fbvortex> kaustuv: you mean extlib?
<kaustuv> No, OCaml Batteries Included. It extends ExtLib along many axes.
<tsuyoshi> module Array = struct include Array let get = (+) end
<tsuyoshi> let foo = 2
<tsuyoshi> foo.(3)
<tsuyoshi> unfortunately you can't do 2.(3)
s4tan has joined #ocaml
<fbvortex> kaustuv: yes, the BI ocaml has the notion of "capabilities" for an array including the ability to make it read-only
<fbvortex> too bad it's in alpha, but I may start using it anyway.
<fbvortex> this seems like it could be very cool if it gets some momentum and the community standardizes on it
<kaustuv> It's got a fair bit of buzz already. Also, many (all?) of the committers to the project hang out on this channel
<fbvortex> kaustuv: awesome, thanks for pointing this out.
<kaustuv> Don't thank me, thank Yoric[DT], thelema, etc.
* Yoric[DT] blushes.
<fbvortex> I think the BI manifesto understates things a little. it's not just the need for a comprehensive standard library, but also for a richer set of built-in data structures and types that are best implemented as part of the language.
<fbvortex> OK, well thanks to the devs of BI, and thanks to you kaustuv for pointing it out. i saw some reference to "batteries included" OCaml and figured it was just a bunch of common packages bundled together (this is what it means in Tcl, for example). however, it's much more than that, so I appreciate your pointing me to it.
chickenzilla has quit [Read error: 113 (No route to host)]
<kaustuv> Heh. Time to add another notch to the bedpost, Yoric[DT].
<fbvortex> night all.
fbvortex has quit [Remote closed the connection]
seafood has joined #ocaml
kaustuv has left #ocaml []
jeremiah has quit [Read error: 104 (Connection reset by peer)]
jeremiah has joined #ocaml
Associat0r has quit []
angerman has quit []
<bjorkintosh> kaustuv_, paulson's book can readily be translated to ocaml though, right?
<rwmjones> we ought to have a little daily graph recording whether harrop is pro or anti ocaml today
<rwmjones> today he seems to be pro
<bjorkintosh> who is harrop?
<m3ga> harrop is one of those socially inept people that always seems to piss everyone else off
<m3ga> he happens to use ocaml and is constantly bitching about this that and the other
<m3ga> he rarely does anything constructive
<m3ga> his book 'ocaml for scientists' is supposed to be quite good
<bjorkintosh> really?
angerman has joined #ocaml
<m3ga> err, which bit?
<Yoric[DT]> rwmjones: :)
<rwmjones> I have a copy of ocaml for scientists, it's not too bad
<rwmjones> jon gave it to me when I met him back in ~2005
<mfp> Yoric[DT]: what do you think about F#'s use foo = ... in ... ?
<bjorkintosh> how close is F# to ocaml? are they related at all?
<mfp> (would be use IO foo = ... in ... if modules are used instead of objects)
chickenzilla has joined #ocaml
<rwmjones> bjorkintosh, F# language was originally derived from OCaml (at the language level). The other big difference is F# isn't free software.
sgnb has left #ocaml []
<bjorkintosh> oh
<Yoric[DT]> mfp: mmmmhhh....
<mfp> bjorkintosh: they share the core language. F# adds to it its own OO, overloading, some monadic stuff, etc., but lacks functors, polymorphic variants, camlp4 and stuff
<Yoric[DT]> I don't think it would be that easy.
<Yoric[DT]> e.g. you would need to differentiate between inputs and outputs
gaze__ has quit []
m3ga has quit ["disappearing into the sunset"]
<mfp> yes use IO.In foo = ...
sgnb has joined #ocaml
<Yoric[DT]> I'm not quite sure it would make life any easier than, say, [with_file_in].
<mfp> yeah not much is gained since it's explicit
<mfp> use foo = .... with objects (< dispose : unit; ..>) , though, would be another story
<Yoric[DT]> That's true.
<mfp> hmm following Paul Pelzl's msg, maybe IO.input should be 'a IO.input (with capabilities for random access) after all?
* Yoric[DT] reads.
<mfp> with create_seekable_in : read:(unit -> char) -> input:(string -> int -> int -> int) -> seek:( ... ) -> close:(unit -> unit) -> [> `Seek] input
<mfp> [`Seek] input, that is
* Yoric[DT] will return in about 5 minutes.
<Yoric[DT]> mmmmhh....
<Yoric[DT]> Well, the class-based approach is quite tempting.
* mfp realizes there's no function for input_channel (open_in x)
<Yoric[DT]> The problem being that OO is really slower than records.
<Yoric[DT]> In addition to which I don't see any trivial solution to the problem of auto-flushing / auto-closing wrapped outputs, as soon as we start using OO Channels.
<mfp> as for seeking, it can be added to the current design if capabilities are added to input/output
<Yoric[DT]> Mmmmhh....
* Yoric[DT] wonders what would happen if we had
<Yoric[DT]> [> `Seek of some_type_of_seek ] input
<Yoric[DT]> and a function
<mfp> exactly
<Yoric[DT]> get_capability : foo input -> foo
<Yoric[DT]> Probably something weird, though :)
<mfp> get_capability, what for?
Snark_ has joined #ocaml
<mfp> just IO.seek : [> `Seek of 'a] input -> 'a -> unit and stuff
<Yoric[DT]> Mmmmhhh....
<Yoric[DT]> Yeah.
<Yoric[DT]> Sounds like a good idea.
<Yoric[DT]> Would you be interested in implementing it?
<mfp> ok, sounds easy
<Yoric[DT]> Well, the hard part is adapting every single bit of the library.
<Yoric[DT]> But it sounds worth it.
mishok13 has quit [Read error: 60 (Operation timed out)]
mishok13 has joined #ocaml
<mfp> Yoric[DT]: should output be (`cap, `output) output or (`out, `cap) ?
<Yoric[DT]> Isn't the output a capability?
<mfp> (I obviously meant to use 'x instead of `x above)
<Yoric[DT]> sure
<mfp> IO.close_out : ('a, 'b) output -> 'a or ('a, 'b) output -> 'b ?
<Yoric[DT]> I tend to believe that the accumulator should be the last parameter, as it's only used at the end.
kaustuv has joined #ocaml
<mfp> if I want to build w/o the docs, it's make byte opt top syntax install ?
<Yoric[DT]> yes
<mfp> ocamlfind: _build/src/syntax/pa_strings/pa_strings.cma: No such file or directory :/
<mfp> my bad, should have done configure again
* Yoric[DT] had just hit the same problem :)
jeremiah has quit [Read error: 104 (Connection reset by peer)]
<kaustuv> I have a gripe about batteries configure: it simply ignores --prefix and tries to install into the system directories.
<mfp> there's something wrong with configure: the generated META still has version="0.20090128"
<Yoric[DT]> kaustuv: that's weird.
<Yoric[DT]> Could you file a bug report?
<Yoric[DT]> Ah, I see the problem.
<mfp> VERSION=0.20090128 in configure.ac
<kaustuv> the problem is ocamlfind which needs the environment variable OCAMLFIND_DESTDIR set
<Yoric[DT]> Mmmmhh....
<Yoric[DT]> That may prove annoying to solve.
<Yoric[DT]> mfp: fixed.
<mfp> uh, cannot use an empty polymorphic variant type, so need a dummy "base capability"...
<mfp> just huh `Read ?
<Yoric[DT]> No empty polymorphic variant type?
<mfp> val pipe : unit -> [`Read] input * ([`Write], unit) output
<Yoric[DT]> Ah yes, it's a parser limitation, iirc.
<Yoric[DT]> `Read sounds weird
<Yoric[DT]> Why not [> ]?
<flux> this reminds me, did someone find a way to perform union set to polymorphic variant types?
<Yoric[DT]> I don't think it's possible.
<mfp> would unify to [> `Seek] if we do IO.seek io s later
<mfp> it must be a closed type
itewsh has joined #ocaml
<Yoric[DT]> kaustuv: should be fixed.
<Yoric[DT]> If you wish to test it.
jeremiah has joined #ocaml
kaustuv_ has quit [Remote closed the connection]
kaustuv_ has joined #ocaml
kaustuv_ has quit [Nick collision from services.]
jeremiah has quit [Read error: 104 (Connection reset by peer)]
<kaustuv> Yoric[DT]: Thanks, I'll try from my office later. This laptop still has 3.11.0+beta1 and type-conv is not compiling.
<Yoric[DT]> ok
<Yoric[DT]> mfp: sorry, no smart idea for the moment
<kaustuv> Did rocquencourt just fall off the internet again or is it just me?
jeremiah has joined #ocaml
<Yoric[DT]> kaustuv: have you contacted Jeremie regarding your Format replacement?
<Yoric[DT]> I've just started toying with Jeremie's printf replacement and I like it.
<Yoric[DT]> And since it's quite modular, it looks like it could very well be upgraded into a full-scale replacement for Format.
itewsh has quit [Connection timed out]
itewsh has joined #ocaml
<kaustuv> Yoric[DT]: no, I haven't. I'll take a look at ExtPrintf later and see what I can do.
<kaustuv> Unfortunately, no time right now.
kaustuv has left #ocaml []
hkBst has joined #ocaml
verte has quit ["http://coyotos.org/"]
s4tan has quit [Excess Flood]
s4tan has joined #ocaml
ched_ has quit [Remote closed the connection]
Ched has joined #ocaml
seafood has quit []
th5 has joined #ocaml
Spiwack has joined #ocaml
<th5> any one else bummed about this tim rentsch thing ?
yziquel_ has joined #ocaml
<yziquel_> hi. i'm trying to bind a perl module in an ocaml module. I understood how to call methods from the perl4caml API ( http://resources.merjis.com/developers/perl4caml/Perl.html ), but I do not understand how to get a specific property of a perl object...
itewsh has quit [Read error: 110 (Connection timed out)]
itewsh has joined #ocaml
<thelema> th5: I'm looking for Hickey to weigh in. How things turn out depends on him and his perspective of Rentch's story.
<thelema> yziquel_: Looking at the API, I'd guess hv_get does what you want.
<thelema> perl objects are usually just blessed hashrefs
<th5> thelema: Yeah.. It's not too clear right now. Especially what their working relationship was. Definitely had some kind of miscommunication. This new book is pretty shady though. This can't be good though. The ocaml community isn't that big.
<th5> I had been waiting for the Hickey book to come out too. I wonder what (if anything) is going on with that.
<thelema> AFAIK, CUP is just sitting on his book.
itewsh has quit [Remote closed the connection]
<yziquel_> thelema: the problem is that blessed objects are of Perl.sv type, not Perl.hv type...
<ehird> Has anyone got batteries working with ocaml3.11/godi?
gaze__ has joined #ocaml
alexyk has joined #ocaml
dabd has joined #ocaml
slash_ has joined #ocaml
jeremiah has quit [Read error: 104 (Connection reset by peer)]
jeremiah has joined #ocaml
alexyk has quit []
kaustuv has joined #ocaml
l_a_m has quit ["Lost terminal"]
<yziquel_> ok. i got it: Perl.string_of_sv (Perl.hv_get (Perl.deref_hash s) "property"). This gets the (string) property of object s. This one-liner should perhaps get it the Perl module...
<kaustuv> This can't be good for his reputation, poor chap. http://www.google.co.uk/search?q=tim+rentsch
l_a_m has joined #ocaml
itewsh has joined #ocaml
willb has joined #ocaml
itewsh has quit [Read error: 60 (Operation timed out)]
itewsh has joined #ocaml
<hcarty> ehird: Batteries works here with GODI + 3.11
<ehird> hcarty: do you not get errors building bin-prot?
<ehird> A bunch of errors like this for me:
<ehird> > Error: The implementation write_ml.ml
<ehird> > does not match the interface write_ml.cmi:
<ehird> > The field `bin_write_array_no_length' is required but not provided
<hcarty> ehird: No such issues here, binprot 1.2.9
<ehird> ... same versions ... wtf!
<ehird> gcc version? I think it may be a cpp problem.
<hcarty> gcc version 4.3.2 (Ubuntu 4.3.2-1ubuntu12)
<ehird> Yeah, I'm on 4.0.1 :\
<ehird> ohh
^authentic has joined #ocaml
^authent1c has joined #ocaml
<ehird> so, anyone having the same troubles on OS X as me, pop this in as /usr/local/bin/cpp:
<ehird> gcc -E -o - -x c $*
<ehird> because /usr/bin/cpp is a shell script that messes everything up.
<ehird> and it works.
<ehird> ah, now sexplib fails. A refreshing change indeed.
<ehird> > File "sexplib.cmx", line 1, characters 0-1:
<ehird> > Error: File type.cmx
<ehird> > was not compiled with the `-for-pack Sexplib' option
<ehird> > ocamlfind ocamlc -package type-conv -c -I +camlp4 -for-pack Usexplib type.ml
<ehird> Now what is that supposed to mean.
authentic has quit [Read error: 110 (Connection timed out)]
^authent1c is now known as authentic
Alpounet has joined #ocaml
s4tan has quit []
^authentic has quit [Read error: 110 (Connection timed out)]
<th5> yeah - i'm trying to figure out the best way to use ocaml on OS X too
<th5> just that macports and fink dont come close to the ocaml support as debian and fedora
jld has quit ["brb"]
<th5> i like GODI - but its just ocaml (so have to have seperate package manager for GTK+ for instance)
<th5> right now i just made a "sandbox" directory where i compiled everything manually - ugh
Camarade_Tux has joined #ocaml
<ehird> th5: godi is fine I just wish it workd
<ehird> *worked
<th5> ehird: just be glad we aren't on windows :-P
<ehird> heck yeah
<ehird> but i do not think this is an os x problem
<ehird> does Usexplib mean unicode sexplib or something I wonder
<th5> well i think he is working on 3.11 - should be out soon enough
<ehird> 3.11 exists
<ehird> -section 3.11
itewsh has quit [Connection timed out]
itewsh has joined #ocaml
ttamttam has left #ocaml []
th5 has quit []
<Yoric[DT]> Quick poll.
<Yoric[DT]> Assuming that there were a toplevel directive to inspect the contents of a module, how would you call it?
<Spiwack> I would call it "#print" but I've got a Coq-deformation ;)
<Snark_> Yoric[DT], #inspect ?
Snark_ is now known as Snark
<Spiwack> (oh and by the way, I love the idea)
<Yoric[DT]> (by the way, you may see it at work at http://ocaml.pastebin.com/m5718506f )
<Yoric[DT]> Thanks :)
<Yoric[DT]> It's Alpounet's fault, he's been teasing me with his OCaml bot for a few days.
alexyk has joined #ocaml
<Yoric[DT]> And he's been doing things which are not possible with the toplevel.
<Yoric[DT]> I had to counter-attack :)
<Spiwack> good boy ;)
<ehird> Haskell uses #browse, fwiw.
<Yoric[DT]> Snark: my problem with #inspect is that such a directive should be able to work on modules but also on everything else.
<Spiwack> #print_module :p
<Yoric[DT]> I don't think I can extend the directive to work on something other than a module.
<Yoric[DT]> :)
<ehird> Yoric[DT]: can't you just do
<ehird> module X = Int32;;
<ehird> for the same result
<Yoric[DT]> ehird: well, that's the underlying mechanism.
<Yoric[DT]> But not everyone knows about that mechanism.
<Snark> Yoric[DT], s/logand/log_and/ ?
<ehird> Yoric[DT]: I'd call it #browse.
<Alpounet> or #browse_module
<Yoric[DT]> I'm ok with #browse.
<Yoric[DT]> Snark: ?
<Alpounet> assuming Yoric[DT] will define many other browsing stuffs, like #browse_class, ... :-p
<Yoric[DT]> Hopefully :)
<ehird> Yoric[DT]: Or, or, #peruse!
<ehird> #examine. #investigate.
Spiwack has quit [Remote closed the connection]
<Yoric[DT]> With such names, #examine and #investigate should work with everything.
<ehird> #explore.
<ehird> Yoric[DT]: Just name each differently
<Yoric[DT]> On the other hand, #browse or #explore could work.
<ehird> #peruse is for modules. #explore, classes.
<ehird> >:D
<hcarty> Yoric[DT]: #listmodule
<ehird> #ls
<Yoric[DT]> ehird: tsss
<Yoric[DT]> Mmmmhh....
<Yoric[DT]> #ls or #listmodule sound interesting
<Yoric[DT]> Is this better than #browse?
<ehird> As long as you defined #rm-rf
<ehird> *define
<Yoric[DT]> :)
<Yoric[DT]> You know the worst part?
<Yoric[DT]> I believe we could :)
<ehird> Yoric[DT]: Can we have #fdisk too?
<Yoric[DT]> I'm sure there's a way :)
<Yoric[DT]> It's a shame module Env is closed.
<Yoric[DT]> Otherwise, I'm sure that we could do interesting stuff with it.
* Yoric[DT] wonders how he could convince the toplevel to print the definition of a type.
<ehird> hmm
<ehird> # type x = Int32.t;;
<ehird> type x = Int32.t
<ehird> darn
_zack has quit [Read error: 104 (Connection reset by peer)]
alexyk has quit []
<Alpounet> Yoric[DT], the better for me would be to get the toplevel's output when we play with it in a file or a pipe or a stream...
_zack has joined #ocaml
<flux> in pgocaml I can write something like PGSQL(dbh) "SELECT foo::smallint FROM bar" to make the result to be a "int option list". is there a way to make it "int list"? foo obviously is 'NOT NULL', but the casting makes it possibly NULL..
<flux> I suppose it's easier to just deal with int32's than to deal with int options..
<flux> or perhaps I could extend it to support unnullable_results :)
<flux> (nulls get in the way when using correctly the coalesce function also)
prime2 has joined #ocaml
jld has joined #ocaml
<Yoric[DT]> ehird:
<Yoric[DT]> # type foo = A | B;;
<Yoric[DT]> type foo = A | B
<Yoric[DT]> # type bar = foo;;
<Yoric[DT]> type bar = foo
<Yoric[DT]> => the contents of [foo] were not displayed.
sporkmonger has joined #ocaml
angerman has quit []
jeremiah has quit [Read error: 104 (Connection reset by peer)]
arquebus has joined #ocaml
itewsh has quit [Read error: 110 (Connection timed out)]
itewsh has joined #ocaml
<Alpounet> is there a function for getting the last N elements of a list ?
<Alpounet> (I mean is there a function for doing it)
<hcarty> Yoric[DT]: http://www.pps.jussieu.fr/~li/software/index.html#enhtop -- would this be useful?
jeremiah has joined #ocaml
* Camarade_Tux hopes enhtop finally gets released as a .cma
jeremiah has quit [Read error: 104 (Connection reset by peer)]
Omni|AFK has joined #ocaml
Omni|AFK is now known as Omnifarious
<Omnifarious> I'm one of Tim Rentch's reviewers.
<Alpounet> Hi.
<Omnifarious> Hello there.
<Alpounet> Can you tell us more about this book story ?
<Omnifarious> Not a huge amount more.
* Omnifarious thinks.
<Alpounet> Btw, it's not our business...
* Omnifarious nods.
<Omnifarious> I have known Tim for years.
<Yoric[DT]> hcarty: yeah, I know about this project, and we might eventually integrate it into Batteries.
<Yoric[DT]> The problem is that it requires OCaml's source.
_zack has left #ocaml []
<Omnifarious> Though he did not mention his collaboration with the professor to me.
<Omnifarious> He's also been a lot more distant in the past 2-3 years.
<Alpounet> He may have been working on the book during these 2-3 years
<Omnifarious> I believe he was. That's what I assumed when he asked me to review it.
<Alpounet> 'kay.
<Omnifarious> He and I have also had many small discussion about CS theoretic ideas in that time too. I assumed that's what he'd been spending his time on in those years when he asked me to review it in the middle of last year.
Amorphous has quit [Read error: 110 (Connection timed out)]
<Omnifarious> So, I do not know what the exact story is. But I'm nearly certain that the story of the book being a blatant rip-off isn't true.
<Alpounet> Okay, thanks for informations.
ttamttam has joined #ocaml
<Omnifarious> You're welcome.
<Alpounet> However the book has been written, it seems to be a good work and a good ressource for beginners, that's the important thing.
jeremiah has joined #ocaml
<Omnifarious> Many people have mentioned that it has a very theoretical approach. I hadn't really noticed. But my way of approaching that kind of information makes it unlikely that I'd notice that kind of focus. I knew almost nothing of OCaml when I reviewed it.
<Alpounet> Good point for the book.
<Omnifarious> And it definitely is a good introduction for someone who wants to understand the language, and it has a lot of nice threads leading you to deeper understanding of CS as a whole.
Amorphous has joined #ocaml
<Omnifarious> Anyway, I just thought I'd pop by and say something. :-/
<Omnifarious> I have a similar experience. I helped a girlfriend write a paper a long time ago.
<Omnifarious> I wrote all the software she used for her simulation, and I wrote much of the data analysis software that allowed her to summarize the results.
<Omnifarious> And I suggested one possible interpretation of the data.
<Omnifarious> She wrote the paper.
<Omnifarious> I was never even mentioned. She 'co-authored' it with a fellow grad student.
<Yoric[DT]> :/
<Omnifarious> So, I know full well that the stories behind these kinds of things are often not cut & dried.
<Alpounet> And I guess you broke with this girl some days after... :/
itewsh has quit [Read error: 60 (Operation timed out)]
itewsh has joined #ocaml
<Omnifarious> No... *chuckle* For various reasons it was actually OK with me. It irritates me a little still. But, our relationship had a lot more to it than just this paper.
<Snark> Yoric[DT], I meant most functions had names like "foo_bar", but those functions have foobar as names
<Yoric[DT]> Ah, ok.
<Yoric[DT]> That's the name given in the base library.
Omnifarious has left #ocaml []
ttamttam has left #ocaml []
Snark has quit ["Ex-Chat"]
jeremiah has quit [Read error: 104 (Connection reset by peer)]
^authentic has joined #ocaml
arquebus has left #ocaml []
jeremiah has joined #ocaml
authentic has quit [Read error: 110 (Connection timed out)]
^authentic is now known as authentic
itewsh has quit ["There are only 10 kinds of people: those who understand binary and those who don't"]
jeremiah has quit [Read error: 104 (Connection reset by peer)]
clog has quit [^C]
clog has joined #ocaml
chickenz1lla has joined #ocaml
jeremiah has joined #ocaml
chickenzilla has quit [Nick collision from services.]
chickenz1lla is now known as chickenzilla
alexyk has joined #ocaml
seafood has joined #ocaml
alexyk has quit []
<mfp> Yoric[DT]: I've implemented input/output capabilities + basic seek_in/seek_out
<mfp> it's rather big because I had to change a bunch of .mli files ... 70 files changed, 586 insertions(+), 479 deletions(-)
Demitar has joined #ocaml
^authentic has joined #ocaml
<mfp> Yoric[DT]: and the actual type-safe IO.seek_in and seek_out stuff > http://ocaml.pastebin.com/m70c25855
^authent1c has joined #ocaml
^authentic has quit [Read error: 60 (Operation timed out)]
seafood has quit []
authentic has quit [Connection timed out]
^authent1c is now known as authentic
vuln has joined #ocaml
* Yoric[DT] takes a look.
<Yoric[DT]> mfp: no wrap_in seekable?
<mfp> not sure it's useful --- I admit I don't see the diff between wrap, inherit, etc.
<mfp> wasn't needed directly for the file I/O, so didn't add it
<mfp> (file IO being the only place were creating [> `Seek] ios is trivially correct)
<Yoric[DT]> inherit is an optimized version of wrap
<Yoric[DT]> [inherit] is an optimized version of [create], sorry
<Yoric[DT]> [wrap] is a version of [create] which handles auto-closing
<mfp> if the code looks OK to you, it'd be best to commit ASAP because the work going on with Print & friends will create conflicts otherwise
<mfp> (I already had to resolve a few things when I rebased right after completing this)
vuln has quit ["leaving"]
Fullma has quit [Connection timed out]
joelr1 has joined #ocaml
<joelr1> good day
<joelr1> has anyone used dypgen here?
<joelr1> my code used to compile but now i get: Error: Invalid source file name: "Easy_parser.ml" is not a valid module name.
<hcarty> Any suggestions on a simple OCaml FTP library? I only need to log in (usually anonymous), list files in a directory and download them
<Camarade_Tux> with ftp, you can nearly do it by hand
<hcarty> Camarade_Tux: Yes, I'm thinking I may just use ftp, wget or similar directly
<Camarade_Tux> making an ftp client in the toplevel is quite funny : ok, the server send that, what should to answer, check the docs, respond 40 seconds later ;)
seafood has joined #ocaml
<Camarade_Tux> hcarty, by hand I thought opening a connection, checking the first few messages from the server, sending three messages and that's it, it's a plain-text protocol after all
<hcarty> Camarade_Tux: Ah. With that much work, I may as well use Perl4OCaml and Net::FTP
<hcarty> If that isn't wrapped already
<Camarade_Tux> you can maybe extract some code from mldonkey too
alexyk has joined #ocaml
smimou has quit ["bli"]
sporkmonger has quit [Read error: 110 (Connection timed out)]
<Camarade_Tux> and there are also the libcurl bindings
<Camarade_Tux> he, you discover new ocamlnet modules every day ;)
<hcarty> mfp: Thank you! I thought ocamlnet had something
joelr1 has quit []
<Alpounet> K :)
<Camarade_Tux> the ftp client coded live would have been funnier :D
smimou has joined #ocaml
^authentic has joined #ocaml
Camarade_Tux has quit ["Leaving"]
jlouis_ has quit ["Lost terminal"]
Fullma has joined #ocaml
yziquel_ has quit ["http://www.mibbit.com ajax IRC Client"]
jlouis has joined #ocaml
seafood_ has joined #ocaml
authentic has quit [Connection timed out]
^authentic is now known as authentic
ilor has joined #ocaml
seafood_ has quit [Read error: 145 (Connection timed out)]
seafood has quit [Read error: 110 (Connection timed out)]
<alexyk> did anybody use ocamlgraph here?
<alexyk> btw, ehird: I've solved the problem with ar, ranlib it was, reported to godi list and macports
<ehird> ah
<ehird> alexyk: the next problem you will encounter is cpp
prime2 has quit [Read error: 104 (Connection reset by peer)]
<ehird> put this in /usr/local/bin/cpp:
<ehird> gcc -E -o - -x c $*
Alpounet has left #ocaml []
<alexyk> ehird: nope, that didn't happen
<ehird> because apple's cpp(1) is a shell script that sets -traditional-cpp and a ton of other stuff
<ehird> so it will break
<ehird> alexyk: it breaks packages
<ehird> not godi itself
<alexyk> ehird: interesting; and would it break other Apple stuff? I thought they love their quirks
<alexyk> so we have to have gfind in macports, not find
<ehird> not that I've seen so far; most "modern" stuff calls cc -E
<ehird> plus you can always tweak your path to run tools that use cpp and need the old behaviour
<alexyk> ehird: can you pls tell me ls -l /usr/bin/ar on your box?
<ehird> -r-xr-xr-x 1 root wheel 64448 10 Jul 2008 /usr/bin/ar
<alexyk> and md5sum while we're at it
<ehird> % md5 /usr/bin/ar
<ehird> MD5 (/usr/bin/ar) = feeed88748758a1c62ab794fe593a64e
<alexyk> mine: feeed88748758a1c62ab794fe593a64e /usr/bin/ar,
<alexyk> -r-xr-xr-x 1 root wheel 64448 2008-07-09 23:37 /usr/bin/ar
<alexyk> same
<alexyk> so I don't know how it worked for you then :)
chickenzilla has quit [Read error: 110 (Connection timed out)]
<alexyk> basically macports folks pointed out you do s, ar crs
<alexyk> that does runlib; one guy claimed it's done automatically in a recent ar, but I didn't see that
sporkmonger has joined #ocaml
dabd has quit [Client Quit]
<ehird> it worked magically for me because I am magical.
<ehird> duh.
<ehird> :\
<alexyk> ehird: hope some magic rubs off of you here
<alexyk> :)
* ehird dances to shake magic off
<ehird> Good luck with your further endeavours. :|
<alexyk> okok
<alexyk> fighting lablgtk2
<ehird> why bother with gtk on os x
<alexyk> the guy maintaining lablgl asked me to do it in response to a question why it's old in godi -- I guess godi isn't very fresh
<alexyk> ehird: I need ocamlgraph and it uses gtk2
<ehird> ah
<alexyk> and I got Aqua-only install, hate x11 widgets
<ehird> alexyk: gtk on os x, even with aqua, doesn't look or act native
<ehird> it's quartz, not aqua
<alexyk> now I can get all kinds of crap for free -- X stuff gasps at no X
<alexyk> ehird: yep, quartz
angerman has joined #ocaml
<alexyk> ha, port install graphviz +no_x11 +ocaml pulls ocaml-3.11 into macports
<alexyk> I now have 3 ocamls: godi, /usr/local, and now this
<alexyk> and godi lags behind... we need rpm for mac
<alexyk> and debian for it too
<Yoric[DT]> mfp: at first glance, it looks good.
<Yoric[DT]> mfp: could you post this to the mailing-list?
<mfp> k
<Yoric[DT]> (and with this, I'll wish everyone a pleasant night)
Yoric[DT] has quit ["Ex-Chat"]