mbishop changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | Grab OCaml 3.10.2 from http://caml.inria.fr/ocaml/release.html (featuring new camlp4 and more!)
* palomer_ wishes there was a way to turn off case sensitivity in ocaml
<palomer_> I mean case differences between constructors and functions
<yziquel> Anyone willing to help me out with my compiling issues?
m3ga has quit ["disappearing into the sunset"]
<palomer_> The type variable name '_6__7_a_7__6_ is not allowed in programs !!!
<palomer_> yziquel, what's the problem?
* palomer_ wonders what ocaml has against the name _6__7_a_7__6_
<yziquel> palomer: following the instructions on http://www.linux-nantes.org/~fmonnier/OCaml/ocaml-wrapping-c.php
<yziquel> palomer: things seem to work fine up to the ocamlmklib stage, and that's where I get an error saying:
<yziquel> used when making a shared object; recompile with -fPIC
<yziquel> stubs.o: could not read symbols: Bad value
<yziquel> collect2: ld returned 1 exit status
<yziquel> usr/bin/ld: stubs.o: relocation R_X86_64_32 against `a local symbol' can not be
<yziquel> used when making a shared object; recompile with -fPIC
<yziquel> stubs.o: could not read symbols: Bad value
<yziquel> collect2: ld returned 1 exit status
vgax has joined #ocaml
robozni has quit [Read error: 104 (Connection reset by peer)]
<qwr> yziquel: .so's should be compiled with -fPIC
vpalle has joined #ocaml
<qwr> yziquel: and wrap.o also
* qwr wonders why ocamlc is used for invoking gcc
<qwr> and why .so is built anyway?
<yziquel> qwr: I do not really know either. So you'd just do gcc -fPIC -g -c -Wall wrap.o ?
<qwr> i'd try that
<qwr> the thing is, that wrap.o seems to be linked into dll_wrap_stubs.so
<qwr> and .so's are meant to be relocationable
<qwr> PIC - Position Independent Code
<yziquel> Yep, I know that part.
<yziquel> OK. and then ocamlmklib -o _stubs stubs.o ...
<vgax> just wandering anyone doing any large projects in ocaml?
<yziquel> qwr: and when I do nm on the .so file, I should still get U caml_alloc_custom ? (U like undefined or unlinked, I guess)
<qwr> nm -D
<yziquel> Aha...
<yziquel> qwr: caml_alloc_custom still shows up with a U.
<qwr> no wonder
vgax has quit ["http://www.mibbit.com ajax IRC Client"]
<yziquel> I know there's no miracle, but I do not yet understand the reason.
<qwr> it's not in the .so
<qwr> try nm -D /usr/lib/libz.so or something similar
<qwr> U is something used by .so library
<qwr> that is expected to be linked dynamically at runtime
<qwr> T is something exported by .so library
<yziquel> qwr: so I now have to run ocamlc -a on my .cmo, the .so and all the other dependencies?
<qwr> suspicious
* qwr would expect, that you have to give the .so when finally linking the binary
<qwr> but i don't really know what magic ocaml compiler can do
<yziquel> qwr: I just want to create a .cm(x)a, and eventually a custom toplevel. That's the plan.
vpalle has quit ["Leaving"]
<orbitz> ocaml website shoudl cover this
<yziquel> OK.
<yziquel> Thanks a lot. That really helped me out. (And I've been checking around this URL already, thanks.)
<orbitz> it's not particularly hidden:)
delamarche has quit []
<yziquel> orbitz: It's not hidden, just a bit dense for a first contact with Caml since 1999.
<orbitz> i haven't really used the o in ocaml that much yet, i should probably take a peek at it
det has joined #ocaml
cybercobra has joined #ocaml
<cybercobra> anyone read "Expert F#"?
<orbitz> not I
<orbitz> i ben Jon Harrop has
<cybercobra> any suggestions as to a good book on any of the ML languages?
postalchris has joined #ocaml
postalchris has quit [Client Quit]
<qwr> first 3 links from googling ocaml book?
<cybercobra> nm. #sml pointed http://www.cs.cmu.edu/~rwh/smlbook/online.pdf out to me, which looks quite nice
m3ga has joined #ocaml
<qwr> iirc both Introduction to Objective Caml and Developing applications with Objective Caml were quite good?
* qwr . o O ( one non-book link to: http://pauillac.inria.fr/~remy/cours/appsem/ )
cybercobra has left #ocaml []
<orbitz> do ocaml'rs prefer to move container objects between various types depending on how they want to use them or is there an interest in creating a stnadard way to iterate over something so you can use all the same functions? like instead of List.fold_left, we'll just have a Iter.fold_left that will take an iterator or a stream and work on it?
pango_ has quit [Remote closed the connection]
pango_ has joined #ocaml
^authentic has joined #ocaml
<yziquel> qwr: FYI, when I create the dll_woble.so file, you need to link it to other c files. Otherwise, you may create a .cma file, but the toplevel will refuse to load it.
<yziquel> Thanks. Problem solved.
authentic has quit [Connection timed out]
^authentic is now known as authentic
* palomer_ loves writing (* TODO : might be buggy, check later *)
<palomer_> makes finding bugs easy:P
<palomer_> don't you just hate it when there's one last thing to get everything working
<palomer_> but doing that one last thing involves changing a lot of code
<orbitz> shoulda designed it better!
<palomer_> yes!
<palomer_> it works!
* palomer_ does a little dance
* palomer_ realizes that all this has to be rewritten in a cleaner fashion
* palomer_ DOH!s
<palomer_> btw, when I should I use class types over purely virtual classes?
<orbitz> wehn you have helper functions you don't want to be exposed?
det has quit [Remote closed the connection]
<palomer_> orbitz, for example?
^authentic has joined #ocaml
<palomer_> is there an easy way to open an xterm and run a command in ocaml?
jonafan_ has joined #ocaml
<palomer_> I'm writing an IDE and this would be a useful thing
<palomer_> for running code
bluestorm has joined #ocaml
<palomer_> anyone know how to do that with class types
<palomer_> 3200 locs !
<palomer_> holy crap
<palomer_> http://ocaml.pastebin.com/m332fbb32 <-- this outputs 67395036
<palomer_> should output 0, no?
<palomer_> woops, my bad
<palomer_> so marshalling works with references, right?
authentic has quit [Read error: 110 (Connection timed out)]
^authentic is now known as authentic
jonafan has quit [Read error: 110 (Connection timed out)]
jonafan has joined #ocaml
<palomer_> I use functional values throughout my code
<palomer_> how am I supposed to marshal them?
palomer_ has quit [Remote closed the connection]
^authentic has joined #ocaml
jonafan_ has quit [Read error: 110 (Connection timed out)]
Kopophex has quit ["Leaving"]
authentic has quit [Read error: 110 (Connection timed out)]
^authentic is now known as authentic
shortcircuit has quit [Remote closed the connection]
prince has quit [Client Quit]
ikaros has joined #ocaml
^authentic has joined #ocaml
authentic has quit [Read error: 113 (No route to host)]
^authentic is now known as authentic
szell has quit [Client Quit]
szell has joined #ocaml
jonafan_ has joined #ocaml
Linktim has joined #ocaml
jonafan has quit [Read error: 110 (Connection timed out)]
schme has joined #ocaml
alexyk has joined #ocaml
<alexyk> how do I create a set of integers -- what module pass to Make?
<flux> module IntSet = Set.Make(struct type t = int let compare = compare end)
<flux> sorry, no Int-module, it would fit that purpose very nicely though
<alexyk> yeah, saw an example with String, replaced by Int, scratched head :)
Linktim has quit [Read error: 110 (Connection timed out)]
<bluestorm> there also is the romantic (let compare = (-)) version, but it actually is a bad solution because of the potential overflow
<alexyk> hmm -- how do I add to it? did let cust_set = IntSet.empty;; ... IntSet.add cust_set row;; complains: This expression has type IntSet.t but is here used with type IntSet.elt = int ??
<alexyk> IntSet per flux above
<flux> the arguments go in reverse
<flux> for reasons with explanations I'm not completely satisfied with :)
<alexyk> weird!
<alexyk> match question: at toplevel, I define some variables which are naturally processed with List.map, so I stick them in a list, and then compute some derived values as [d1;d2;d3] = List.map produce_derived original;;
Linktim has joined #ocaml
<alexyk> that gives an incomplete match warning
<alexyk> but I define globals this way so am not sure if I can wrap this in a match
<alexyk> or can I?
<bluestorm> hm ?
<bluestorm> aah
<bluestorm> alexyk: i've got a syntax extension for you :]
<alexyk> bluestorm: I'm all ears!
<alexyk> wow! that was fast :))
OChameau has joined #ocaml
<alexyk> my inputs are in fixed fields: " 1 2 123" and scanf "%d %d %d" complains on the leading spaces in the first field -- what s=format spec
<alexyk> eats the leading space for ints?
<alexyk> bluestorm: do you have a plain txt version of your lovely pa_refutable.ml?
<bluestorm> yes, of course
<bluestorm> i should have given this url too, sorry
<alexyk> got it, thx! usage shows two lines -- are they both needed or alternatives?
<acatout> alexyk: Just add a leading space to your format string: " %d %d %d".
<alexyk> acatout: thx!
<alexyk> bluestorm: and how is it used with ocamlopt?
<bluestorm> hmm
<bluestorm> ocamlopt -pp ... ...
<bluestorm> pa_refutable itself is compiled into bytecode but you can use it to preprocess before ocamlopt
<bluestorm> i plan to use a findlib-friendly META-file soon, so that it's easier to use
<alexyk> nice
hkBst has joined #ocaml
<alexyk> bluestorm: amazing, nasty multi-line warnings with examples of [] went away!
OChameau has quit ["Leaving"]
ygrek has joined #ocaml
<alexyk> adding an element to a set gives warning? Warning S: this expression should have type unit.
<alexyk> IntSet e set
<alexyk> why?
<petchema> IntSet.add ?
<alexyk> ys
<alexyk> yes
<alexyk> IntSet.add e set; more; -- in a sequence gives that warning
<petchema> yes, IntSet has a functional interface, it returns the set with the extra element added
<petchema> val add: elt -> t -> t
<alexyk> oh, so it doesn't modify the original as Array?
<petchema> no
<alexyk> oh, my sets are huge, wanted to make it look better than Array... but now looks wasteful
<petchema> nope, most of the new set is shared with the old one
<petchema> so it's not wasteful at all
<alexyk> so let set = IntSet.add e set is ok?
<petchema> that's the benefit of immutable datastructures: knowing that they can't be modified, you have more freedom for sharing them safely
<alexyk> and previously I had cust_list a global Array, was modifying it in place. If now I say cust_set = IntSet e cust_set somewhere in a function, will it be the global which we're modifying?
<petchema> nope, you're creating another cust_set that will shadow the previous one (within its local scope)
<alexyk> yes -- am getting a warning that cust_set is unused, so I guess it's not so easy to use as a global Array here... a global ref then?
<petchema> if you don't want to rewrite everything functional-style, you could use a global IntSet.t ref, yes
<alexyk> functional style here would be to tack on another parameter to carry everywhere and use in only one place :)
<petchema> so?
<qwr> alexyk: Hashtbl can be used as mutable set
<alexyk> am already carrying three counters like that... Smerdyakov suggested writing a high-level function with a closure, which will be in my Summer plans to understand and find examples of :)
<alexyk> for specific cases I'm doing
<alexyk> qwr: was doing Hashtbl before in fact, tried to employ Set to learn it, and just found it's awkward, requires a functor instantiation, and is plain a difficult customer :)
<qwr> depends, what you're doing...
<alexyk> petchema: when I do, inside a function, cust_set := IntSet.add e !cust_set, will it still know to reuse most of it even across dereference/assignment?
* qwr has to admit usually just using Hashtbl
<qwr> alexyk: that ref won't matter at all
<petchema> alexyk: yes, it's just that the previous version loses its only reference, so what's not shared with "current version" (if any) will eventually be reclaimed by the GC
<bluestorm> alexyk:
<bluestorm> you can have a look at the actual output (post-preprocessing) with camlp4o pa_refutable.cmo yourfile.ml
<alexyk> bluestorm: ok, got it
bluestorm has quit ["Konversation terminated!"]
Linktim_ has joined #ocaml
Demitar has quit [Read error: 110 (Connection timed out)]
Demitar_ has quit [Read error: 110 (Connection timed out)]
Linktim- has joined #ocaml
Linktim has quit [Read error: 110 (Connection timed out)]
ygrek has quit ["Leaving"]
Linktim_ has quit [Read error: 110 (Connection timed out)]
<alexyk> is there a way to tell Array.sort we want to sort only a part 1..N ?
Linktim- has quit [Read error: 110 (Connection timed out)]
Linktim- has joined #ocaml
vbmithr has joined #ocaml
^authentic has joined #ocaml
Linktim_ has joined #ocaml
coucou747 has quit ["bye ca veut dire tchao en anglais"]
authentic has quit [Read error: 110 (Connection timed out)]
^authentic is now known as authentic
schme has quit [Remote closed the connection]
Linktim- has quit [Read error: 110 (Connection timed out)]
coucou747 has joined #ocaml
LordMetroid has joined #ocaml
sporkmonger has joined #ocaml
lordmetroid_ has joined #ocaml
^authentic has joined #ocaml
^authent1c has joined #ocaml
LordMetroid has quit [Connection timed out]
authentic has quit [Read error: 110 (Connection timed out)]
^authent1c is now known as authentic
Linktim_ has quit [Read error: 110 (Connection timed out)]
lordmetroid__ has joined #ocaml
RobertFischer has joined #ocaml
<qwr> what #arity something means in sml?
<qwr> seems to result in function
* qwr attempts to translate one sml example into ocaml...
<qwr> err, not a function. number instead
<kig> argument count?
<kig> (guessing)
^authentic has quit [Read error: 110 (Connection timed out)]
<qwr> possible...
<qwr> hmm. looks like number of fields in record here?
<qwr> no. it's goddamn field selector!
<qwr> like something.arity in ocaml...
<kig> oh yeah
<kig> #x { x=3 }; > val it = 3 : int
<kig> map #x [{x=1, y=3}, {x=2, y=5}, {x=8,y=4}];
<kig> > val it = [1, 2, 8] : int list
<kig> that's pretty cool
lordmetroid_ has quit [Connection timed out]
Linktim has joined #ocaml
lordmetroid_ has joined #ocaml
RobertFischer has quit [Read error: 104 (Connection reset by peer)]
RobertFischer has joined #ocaml
prince has joined #ocaml
prince has quit [SendQ exceeded]
prince has joined #ocaml
lordmetroid__ has quit [Read error: 110 (Connection timed out)]
hkBst_ has joined #ocaml
Linktim has quit [Read error: 110 (Connection timed out)]
lordmetroid_ has quit [Success]
LordMetroid has joined #ocaml
alexyk_ has joined #ocaml
RobertFischer has quit [Read error: 104 (Connection reset by peer)]
RobertFischer has joined #ocaml
Ramzi has quit [Read error: 104 (Connection reset by peer)]
Ramzi has joined #ocaml
alexyk has quit [Read error: 110 (Connection timed out)]
RobertFischer_ has joined #ocaml
RobertFischer has quit [Read error: 104 (Connection reset by peer)]
damg has joined #ocaml
struk_atwork has joined #ocaml
OChameau has joined #ocaml
lordmetroid_ has joined #ocaml
Linktim has joined #ocaml
RobertFischer_ has quit [Read error: 104 (Connection reset by peer)]
RobertFischer has joined #ocaml
RobertFischer has quit [Read error: 104 (Connection reset by peer)]
vfdfdfvd has joined #ocaml
RobertFischer has joined #ocaml
Yoric[DT] has joined #ocaml
LordMetroid has quit [Connection timed out]
Linktim_ has joined #ocaml
<damg> are there unsigned integer types available in ocaml?
<hcarty> damg: Only when using the Bigarray module. And even then it is only the storage which is unsigned - you still interact with the Bigarray fields using signed integers
<hcarty> A few people have put some work in to UInt32 and UInt64 modules though, I think
<damg> I want to write a 68k bytecode interpreter (the bsvc is so broken ..) and for such stuff uints of different width are needed
<Smerdyakov> SML has much better support along these lines.
Linktim has quit [Read error: 110 (Connection timed out)]
<damg> I also thought of erlang with its bit syntax, but preferred ocaml in the first place :-)
<damg> well, right tool for the right job :E
<damg> thank you for the information!
Linktim- has joined #ocaml
<Yoric[DT]> hi
hkBst has quit [SendQ exceeded]
<RobertFischer> Yoric[DT]: Hey.
<Yoric[DT]> How do you do ?
<RobertFischer> Been better. I'm in the hospital after getting my deviated septum taken care of. Pretty excited to leave.
<RobertFischer> As a general piece of weirdness, the hospital does not allow you to use cell phones, but they *do* have building-wide wifi. How's that work?
<Yoric[DT]> Weird.
<Yoric[DT]> Can I understand you're better, though ?
<Yoric[DT]> s/understand/take it/
love-pingoo has joined #ocaml
delamarche has joined #ocaml
<tsuyoshi> so.. is there an effort to make a new standard library for ocaml?
Linktim_ has quit [Read error: 110 (Connection timed out)]
Linktim_ has joined #ocaml
<tsuyoshi> I remember reading something about it
<Yoric[DT]> Yup.
Linktim- has quit [Read error: 110 (Connection timed out)]
<Yoric[DT]> A super-ExtLib.
ikaros has quit [Read error: 113 (No route to host)]
ikaros has joined #ocaml
OChameau has quit [Read error: 113 (No route to host)]
pango_ has quit [Remote closed the connection]
vfdfdfvd has quit [Remote closed the connection]
vfdfdfvd has joined #ocaml
pango_ has joined #ocaml
delamarche has quit []
RobertFischer has quit []
magthe has joined #ocaml
bluestorm has joined #ocaml
Linktim- has joined #ocaml
<tsuyoshi> Yoric[DT]: where is this? and what are they intending to add to it?
<Yoric[DT]> Up for debate :)
<Yoric[DT]> (and no source code available yet)
* Yoric[DT] copies and paste from an e-mail he's writing.
<Yoric[DT]> Standard library:
<Yoric[DT]> * ExtLib
<Yoric[DT]> + exception-less error management (that is, make sure that functions which can decide to raise exceptions have a name suffixed with _exn) (in progress)
<Yoric[DT]> + a module ExtStream (in progress)
<Yoric[DT]> + lazy lists (done)
<Yoric[DT]> + labelled variants of modules (in progress)
<Yoric[DT]> + getting stuff out of MoreLabels and into something nicer (in progress)
<Yoric[DT]> + a module ExtGenLex working with Enum and LazyList (in progress)
<Yoric[DT]> After that, I'm planning to get something done on
<Yoric[DT]> * ropes
<Yoric[DT]> * integration with Camomile
<Yoric[DT]> * getting rid of strings and replacing them with ropes
<Yoric[DT]> all that and a set of syntax extensions
Morphous has joined #ocaml
<Yoric[DT]> and the necessary hacks to get all of this to work without having to know that it comes from several distinct sources
prince has quit [Client Quit]
<bluestorm> Yoric[DT]: are you planning to integrate SDFlow into ExtStream ?
<Yoric[DT]> I need to check the licence and naming conventions.
<Yoric[DT]> But yes, I'd like to.
<bluestorm> the naming conventions should be quite correct as he reuse the Stream interface
<bluestorm> anyway, i'd be a bit more interested in your "camlp4 extension list" :]
<Yoric[DT]> :)
<Yoric[DT]> Actually, would you like to handle that ?
<bluestorm> hmm
<bluestorm> why not
<bluestorm> i would have a hard time trying to get my own extensions in a common list, but well
<hcarty> Yoric[DT]: What is the reason for moving away from exceptions?
<bluestorm> i could do that and let the other criticize :-'
<Yoric[DT]> bluestorm: :)
<bluestorm> Yoric[DT]: i'm not sure about how small/big this list should be
<Yoric[DT]> hcarty: it's more along the lines of marking clearly exceptions than completely removing them.
<Yoric[DT]> And making it possible for people who don't want exceptions at all to work without exceptions.
<Yoric[DT]> bluestorm: my personal list was along the lines of open_in, try...finally, let...try, something for lazy lists (not necessarily mine) and something for list comprehensions (as above).
<bluestorm> anyway i could still try two list
<Yoric[DT]> Yeah, I'd go with two lists anyway.
<Yoric[DT]> Some would be opened by default, some should just be easy to open.
<hcarty> Yoric[DT]: Makes sense, though I cringe a little at the ugly extra 4 characters to type :-)
<Yoric[DT]> hcarty: :)
<bluestorm> one "essential list" (with your proposal and maybe some other very useful thing), and a fancy list with everything we could reasonably get in shape with a nice META and all that
<Yoric[DT]> yep
<Yoric[DT]> Anyway, it was your idea in the first place :)
<bluestorm> :p
<hcarty> The OO syntax extension, or a subset of it, may be worth including in the list
<bluestorm> hcarty: you'll have to choose between an additionnal "_exn" and a heavy 'a option handling, so be happy with only 4 more chars :-'
Linktim_ has quit [Read error: 110 (Connection timed out)]
<hcarty> bluestorm: That's my bigger concern, honestly :-) I don't want to have to unwrap everything from an 'a option. But more experienced folks than I claim it is ok with the right library support.
<Yoric[DT]> Anyway running out of batteries, gottago.
<Yoric[DT]> Cheers.
<bluestorm> and i'm quite sure Yoric[DT] will provide an Option module with steroids, and maybe an Either one too
<bluestorm> s/with/on/
<Yoric[DT]> Sounds quite possible.
Linktim_ has joined #ocaml
<Yoric[DT]> Cheers.
Yoric[DT] has quit ["Ex-Chat"]
lordmetroid_ has quit [Connection timed out]
Amorphous has quit [Connection timed out]
Linktim- has quit [Read error: 110 (Connection timed out)]
Linktim- has joined #ocaml
olegfink has quit [Read error: 104 (Connection reset by peer)]
olegfink has joined #ocaml
magthe has quit ["Ex-Chat"]
szell has quit [Connection timed out]
Linktim_ has quit [Read error: 110 (Connection timed out)]
coucou747 has quit ["bye ca veut dire tchao en anglais"]
Linktim- has quit [Read error: 110 (Connection timed out)]
coucou747 has joined #ocaml
jonafan_ is now known as jonafan
<orbitz> hey bluestorm
<bluestorm> ?
<orbitz> how are you today
<bluestorm> fine, why ?
<orbitz> i'm secretly a PI and keeping tabs on you for an un-named beneficiary
<bluestorm> no very likely, it's public knowledge that i'm always fine
<orbitz> i'll note that in my log
<acatout> bluestorm: You mean you manage to avoid any side effect?
<bluestorm> i'm pure too :-'
<orbitz> is there any interest in ocaml to provide an iterator/generator/stream-like interface in order to have more uniform way to iterate over containers?
<bluestorm> orbitz: you're talking of your code, or a specific library, or dreaming about the "perfect extlib" ?
<orbitz> dreaming i suppose
<bluestorm> hmm
<orbitz> i don't have a particular problem
<bluestorm> if you have a particular datastructure and you want to provide a stream-like interface, i think you could use streams
<bluestorm> (Stream.from is quite handy to generate streams from any lazy generation process)
<bluestorm> an other choice would be Extlib's Enum, obviously, but haven't used them and don't know how to create one, though it should not be very difficult
<orbitz> would there be a benefit to moving fold_left/fold_right/map/etc to an Iter or Stream module that simply takes an iterato or stream or is such a think more toruble than it's worth in ocaml?
<bluestorm> Enum provides a "from" function that is quite similar to Stream.from, so it would be easy too
* orbitz pokes at enum
<bluestorm> Extlib's Enums do have fold/map/filter/etc.
<bluestorm> and if you want to use Stream, you could use the improved Stream module by Zheng Li : http://www.pps.jussieu.fr/~li/software/sdflow/doc/html/Sdflow.html
<bluestorm> of course, at least 3 different people on that channel plan to include those two library in an improved common hypoallergenic library
Linktim has joined #ocaml
<orbitz> hah
vfdfdfvd has quit ["Leaving."]
robozni has joined #ocaml
postalchris has joined #ocaml
vfdfdfvd has joined #ocaml
love-pingoo has quit ["have a nice week-end"]
vfdfdfvd has left #ocaml []
evn_ has joined #ocaml
Poulet has joined #ocaml
alexyk has joined #ocaml
alexyk_ has quit [Read error: 104 (Connection reset by peer)]
mbishop has quit [Read error: 104 (Connection reset by peer)]
mbishop has joined #ocaml
sporkmonger has quit []
pango_ has quit [Remote closed the connection]
pango_ has joined #ocaml
<alexyk> tuareg users: is there a default abbrev for "<-" and "->" ?
LordMetroid has joined #ocaml
<alexyk> is there a way to change an Array size to iter on a prefix? When size is max and actual varies?
<bluestorm> hm
<bluestorm> you may use Array.sub
<bluestorm> or code your own iter_upto : int -> ('a -> unit) -> 'a array
<hcarty> Or use a for loop
<bluestorm> hcarty: noob :-'
<hcarty> Yep, I knew someone had to shoot that down :-)
<bluestorm> (would anyone know an english equivalent to the idiomatic french expression "petit joueur" ?)
<hcarty> Even thought Array.iter IS a for loop!
<hcarty> bluestorm: I don't know French - what does that translate to, roughly, and what is the intended meaning?
<bluestorm> hm
<qwr> hcarty: obviously the library was written by noobs ;)
<bluestorm> it's not very easy to explain with words actually, but i'll try
<bluestorm> hcarty: it's the idea of someone using ridiculously naive/simple/easy tools among other people playing on a much larger scale
evn_ has left #ocaml []
alexyk has quit [Read error: 104 (Connection reset by peer)]
alexyk has joined #ocaml
<bluestorm> an example i found with google is approximatively ( he just got a bright new 19" LCD... petit joueur, we have been using 40" for years now )
<hcarty> bluestorm: I think I understand the intent, but I would have to think about it for a bit to come up with an equivalent expression
<qwr> not really knowning either french or english ;) http://www.eduqna.com/Words-Wordplay/1870-2-words-wordplay.html
<bluestorm> (ah, and it litteraly is "small player")
<bluestorm> heh, "small fry" is not bad at all
<hcarty> Sounds relatively close
LordMetroid has quit [Read error: 104 (Connection reset by peer)]
palomer has joined #ocaml
<palomer> anyone know how marshal marshals objects?
<palomer> does it marshal the methods, or only the values?
<alexyk> Array should have had an effective length below maximum, like Ada string
<alexyk> then iter and sort would be useful for incomplete ones, used as buffers
<alexyk> hmm... can I use string buffers with flexible upper bound?...
Linktim_ has joined #ocaml
Linktim- has joined #ocaml
<hcarty> alexyk: What do you mean a "an effective length below maximum"?
<hcarty> s/mean/mean by/
<alexyk> I declare an Array large enough to hold any row of a matrix
<alexyk> then I sort a row before outputting each
<alexyk> rows are generally shorter than max
<alexyk> and I can't naturally use Array.sort -- I have to fill with initfinity
<alexyk> to shift excess to the right, squeezing it ouf of my subrange
<alexyk> feeling like a laundress!
<alexyk> in Ada, string has a maximum value and a current length under it
<alexyk> remember strings in Pascal-type languages, with max and current length, defined as records?
<alexyk> that's what Array needs imho, a current max in addition to physical one
<hcarty> I haven't used Pascal in 10 or 15 years...
<alexyk> me neither, but I like Ada
<hcarty> Bigarray can do something similar with subs and slices
<hcarty> I haven't used Ada - it looks like it could be very nice, but also seems rather verbose
<alexyk> well FP causes one to use short names and then scratch head
<alexyk> fun x y z da rv lx
<hcarty> And OCaml has me quite sold on functional programming for everything except where it's easier not to
<Smerdyakov> alexyk, "causes"?
<alexyk> a doc is longer then the code
<hcarty> I still use a lot of long names with OCaml
<Smerdyakov> alexyk, it's possible to code in FP languages without using names in confusing ways.
<alexyk> Smerdyakov: induces, goads -- lines are short!
Linktim has quit [Read error: 110 (Connection timed out)]
<qwr> alexyk: you can easily implement such an array
<alexyk> qwr: true
<alexyk> Amerdyakov: do you use long self-descripting names?
<alexyk> (Smerdyakov :)
<alexyk> hcarty: I use Fortran with OpenMP for speed
<alexyk> OCaml is now crunching out a matrix for Fortran to eat!
<alexyk> try to outdo the mighty DO loop
<hcarty> alexyk: Thankfully I haven't run in to speed constraints which OCaml + a bit of C can't handle
Linktim_ has quit [Read error: 110 (Connection timed out)]
<hcarty> But this also means I only use 1 of the two processors I have available on my main number crunching system
<alexyk> hcarty: amazing to see how OpenMP loads them all... 800% on an 8 core box in top
<hcarty> alexyk: What sort of program?
<alexyk> hcarty: Netflix prize!
<alexyk> netflixprize.com
<alexyk> a large matrix SVD
<hcarty> Could you use lacaml?
bzzbzz has quit ["leaving"]
<Smerdyakov> alexyk, I often use multi-word names that are meant to determine completely what the function does, when considering type information, too.
<alexyk> hcarty: what's lacaml?
<hcarty> lapack wrapped for OCaml
<alexyk> hcarty: ah, yes -- but SVD is a very specific task with Fortran open source for decades
<alexyk> so it's a case of better reuse for a job
<alexyk> my BLAS/LAPACK are also hacked ones for parallel SVD
<hcarty> You may be able to use lacaml with them directly, though I am not sure
<hcarty> If you have something working now though then it may not be worth the restructuring effort if this is not a long term project
<alexyk> true
schme has joined #ocaml
<palomer> anyone know how marshal works? specifically, are methods marshalled with an object?
<bluestorm> you should try (i have not)
<palomer> me?
<bluestorm> you
<palomer> me!
<palomer> its hard to tell
alexyk has quit []
<palomer> ah yes, they are stored
<palomer> darn
<palomer> looks like I have to get sexplib installed
<bluestorm> godi is your friend
<hcarty> What are the relative benefits of sexplib vs json_static?
<palomer> cool!
<hcarty> I have used YAML for storing data when working in Perl, but I haven't done any non-binary data storage in OCaml
Linktim- has quit [Read error: 104 (Connection reset by peer)]
<palomer> GODI isn't in my apt-cache :/
Linktim has joined #ocaml
<bluestorm> you can compile it yourself, it goes in /opt neatly
<bluestorm> hcarty: as far as i know, no marshalling solution can marshall all the ocaml values
<bluestorm> there is the closures problem, but also issues with cyclic values and some other things
<palomer> deriving can deal with cyclic values
<bluestorm> the different solution (sexplib, json_static, the deriving part...) fail on different things
<palomer> I don't want my methods to be marshalled
<palomer> Command(s) gm4 m4 not found in /bin /usr/bin /sbin /usr/sbin /usr/local/sbin /usr/local/bin /usr/sbin /usr/bin /sbin /bin /usr/games
<palomer> bluestorm, which one doesn't do closures?
<bluestorm> hm
<bluestorm> i'm thinking of the Marshal module
<bluestorm> but i may be wrong actually : does it ?
<palomer> Marshal does closures
<palomer> let a = Marshal.to_string (fun x -> x) [Marshal.Closures]
<palomer> sexplib doesn't
<palomer> and getting info on json_static doesn't seem to be easy
jeremiah has joined #ocaml
<palomer> doesn't seem that json-static does closures
<palomer> but I can't tell
<palomer> marshal seems to be the only option
<palomer> fear not, I plan to write my own marshalling module in the future!
<bluestorm> hmm
<bluestorm> i may have found a camlp4 bug
pango_ has quit [Remote closed the connection]
pango_ has joined #ocaml
alexyk has joined #ocaml
<alexyk> bluestorm: thx again for beautiful warning-killing refutable!
<bluestorm> :]
Poulet has quit []
<Ramzi> Is there a library function for combining two lists without duplicateds?
<Ramzi> For example, [1;2;3] [3;4;5] -> [1;2;3;4;5]
<orbitz> why not use a set?
<orbitz> or does order matter?
<Ramzi> The specification calls for a list.
<alexyk> my warm and fuzzy feeling so far: "ocaml: write your own darn library functions!" :)
<bluestorm> then you're probably intended to code it yourself Ramzi
szell has joined #ocaml
szell has quit [Remote closed the connection]
<bluestorm> are you in an class homework situation ?
szell has joined #ocaml
<Ramzi> yes, but the assignment isn't, "Write a function that combines two lists and removes duplicates."
<Ramzi> This is just a small part of the larger function.
<orbitz> Ramzi: make em a set and make it a list
<bluestorm> Ramzi: does your class have a policy concerning outside help ? (just asking)
<alexyk> Ramzi: or use a Hashtbl
<alexyk> as an easier thing than Set
<orbitz> why a hashtbl?
<Ramzi> bluestorm: cheating policies are in regard to code copying, not general questions
<Smerdyakov> Ramzi, I wouldn't consider this a general question.
<Smerdyakov> Ramzi, it's specific to the assignment.
l_a_m has quit [Remote closed the connection]
<orbitz> well truthfully
<orbitz> he asked if a function exists
<orbitz> to do this
<orbitz> not how to
<Smerdyakov> Ramzi, do you know where the standard library manual is?
<alexyk> if adults are allowed to ask on IRC instead of grepping docs, students should be, too
<Smerdyakov> alexyk, "adults" and "students" are not mutually exclusive classes.
<Smerdyakov> alexyk, there are very good reasons not to answer very specific homework questions.
<bluestorm> ( in case it helps someone, http://caml.inria.fr/pub/docs/manual-ocaml/libref/List.html )
<alexyk> Smerdyakov: true
vbmithr has quit ["Zz"]
<alexyk> what do folks use to get documentation in toplevel? do I still have to use the trick like module M=Array to see all Array's methods?
postalchris has quit ["Leaving."]
<alexyk> missing Ruby's object.methods.sort.grep 'blah' ...
<bluestorm> :p
<bluestorm> alexyk: you can try #tell from the enhanced toplevel Enhtop ( http://www.pps.jussieu.fr/~li/software/enhtop/README )
LordMetroid has joined #ocaml
<alexyk> interesting
alexyk has quit []
schme has quit [Read error: 110 (Connection timed out)]
<orbitz> i find module M = blah good enough generally
<hcarty> ocamlbrowser is a nice GUI tool for such things if you don't want a browser window open
alexyk has joined #ocaml
jeffno has joined #ocaml
Linktim has quit [Remote closed the connection]
alexyk has quit [Read error: 110 (Connection timed out)]
LordMetroid has quit [Read error: 110 (Connection timed out)]
bzzbzz has joined #ocaml
ikaros has quit ["segfault"]
damg has quit [Read error: 104 (Connection reset by peer)]
coucou747 has quit ["bye ca veut dire tchao en anglais"]
jeffno has quit ["Leaving"]
<palomer> jussieu!
<palomer> I went to jussieu
<bluestorm> tonight ?
coucou747 has joined #ocaml
hkBst_ has quit [Client Quit]
bluestorm has quit ["Konversation terminated!"]
<palomer> 2 years ago
<palomer> ugh
<palomer> time to build a parser generator
<hcarty> What is the point of private abbreviation types in OCaml 3.11, vs simply using abstract types?
<orbitz> what are they?
<hcarty> type t = private int
<orbitz> is that if you don't have a sig for the module?
<hcarty> Sorry, that's in the signature
<orbitz> oh..s
<orbitz> so you put the type in there btu mark it private?
<hcarty> module Foo : sig type t = private int val make : int -> t end = struct let make x = x end;;
<hcarty> Yes
* orbitz shrugs
<orbitz> i shouldhope if it's going into ocaml INRIA really thought it out
<hcarty> The only difference I can see between that and the same abstract type is that the toplevel shows you values of T.t without any extra work
<hcarty> I am sure they did
<hcarty> There was a mailing list thread discussing it, but it didn't seem to go anywhere