mbishop changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | Grab Ocaml 3.10.0 from http://caml.inria.fr/ocaml/release.html (featuring new camlp4 and more!)
jlouis has joined #ocaml
jlouis_ has quit [Read error: 110 (Connection timed out)]
bluestorm has quit ["Konversation terminated!"]
kmeyer has quit [Remote closed the connection]
<yminsky> [[[
<mbishop> ]]]
wy has joined #ocaml
yminsky has quit []
kmeyer has joined #ocaml
glen_quagmire has left #ocaml []
kmeyer has quit [Remote closed the connection]
kmeyer has joined #ocaml
Mr_Awesome has joined #ocaml
thermoplyae has joined #ocaml
sergez has joined #ocaml
kmeyer has quit [Remote closed the connection]
kmeyer has joined #ocaml
mrsolo has joined #ocaml
ser_ has joined #ocaml
sergez has quit [Read error: 113 (No route to host)]
sergez has joined #ocaml
ser_ has quit [Read error: 113 (No route to host)]
sergez has quit [Remote closed the connection]
sergez has joined #ocaml
yminsky has joined #ocaml
buluca has quit [Read error: 113 (No route to host)]
Associat0r has quit []
yminsky has quit []
kmeyer has quit [Remote closed the connection]
kmeyer has joined #ocaml
yminsky has joined #ocaml
yminsky has quit [Client Quit]
sergez has quit []
mordaunt has joined #ocaml
piggybo1 has joined #ocaml
pwnguin has joined #ocaml
<pwnguin> i can't for the life of me figure out why this doesn't type check =(
<pwnguin> let max n (x,y) = if x*y > n then x*y else n;;
<pwnguin> or how to fix it
<pwnguin> hmm
<pwnguin> I thought i tried just max in the interpreter. apparently max is already defined =/
zmdkrbou has quit [Read error: 110 (Connection timed out)]
zmdkrbou has joined #ocaml
thermoplyae has quit [Remote closed the connection]
thermoplyae has joined #ocaml
<thermoplyae> types here
jlouis_ has joined #ocaml
<thermoplyae> and ocaml has no qualms shadowing the built in max, so don't worry about that
kmeyer has quit [Read error: 113 (No route to host)]
kmeyer has joined #ocaml
<qwr> pwnguin: it type-checks.
jlouis has quit [Read error: 110 (Connection timed out)]
<pwnguin> it wasn't for me, but it works now
<pwnguin> i cant recall why
<thermoplyae> all's well that ends well
ygrek has joined #ocaml
thermoplyae has quit ["daddy's in space"]
bluestorm has joined #ocaml
<pwnguin> speaking of shadowing
<pwnguin> can i shadow the infix operators?
<bluestorm> yes you can
<bluestorm> let (+) = (+.)
<pwnguin> excellent
<bluestorm> i use that sometimes, for float-intensive computations
<bluestorm> the old + is still accessible by Pervasives.(+)
<pwnguin> this is small stuff
<bluestorm> pwnguin: however
<pwnguin> but big numbers
<bluestorm> :: isn't an operator
<bluestorm> it's a constructor
<pwnguin> not worried
<pwnguin> its in64
<pwnguin> int64 i need
<pwnguin> there's this site called project euler, and ive been bored enough that I decided to refresh my ocaml with it
<pwnguin> its mostly numerical problems
<kmeyer> yep
<kmeyer> fun stuff
asmanur has joined #ocaml
wy has quit ["Ex-Chat"]
piggybo2 has joined #ocaml
piggybo3 has joined #ocaml
piggybo1 has quit [Read error: 110 (Connection timed out)]
piggybo2 has quit [Read error: 110 (Connection timed out)]
<bluestorm> hmm
<bluestorm> do you think something like that would help with arithmetic syntax worries ?
<bluestorm> the basic idea is to have a common interface for numeric types, that provide standardized syntaxic facilities
<bluestorm> eg. module NInt64 = Numeric(NumInt64);; open NInt64;;
<bluestorm> and the you can use 3L +. 4L or such things
<bluestorm> (the choice to overwrite (+.) operations may be a bit awkward, though, but i think overwriting non-dotted ones would be dangerous, and i'm not sure we often need eg. Int64 and float at the same time)
<bluestorm> (the not-very-interesting module implementation is available at http://bluestorm.info/ocaml/numeric/numeric.ml.html , featuring an audacious use of the pa_refutable syntax extension)
robyonrails has joined #ocaml
<flux> bluestorm, unfortunately numeric performance will likely go down the drains in ocaml with that approach
<bluestorm> hm
<bluestorm> do you think for example Int64 computations
<bluestorm> would be really slowed down ?
<flux> yes.
* pango nods
<bluestorm> hm
<bluestorm> i thought functors were not that costly
pants3 has joined #ocaml
pants2 has quit [Read error: 104 (Connection reset by peer)]
<flux> well, I don't think they are as costly as for example virtual calls are (?), hopefully not atleast in this case
<flux> but still it's a new level of functions
<bluestorm> i should try it on some numeric code
<pango> polymorphism kills all numerical optimizations
<bluestorm> there is no polymorphism here
<bluestorm> hm
<pango> functors relies on polymorphism
<bluestorm> the "compare" thing may have some cost
<bluestorm> pango: so the compiler isn't able to optimize floats in NumFloat for example ?
<pango> yes... At least when I tried functorizing code so I could use any kind of integers, performance was just horrible
buluca has joined #ocaml
<pango> too bad ocamldefun hasn't been updated in ages...
Associat0r has joined #ocaml
ertai has joined #ocaml
Morphous has joined #ocaml
ertai has quit ["leaving"]
Amorphous has quit [Read error: 110 (Connection timed out)]
leo037 has joined #ocaml
Anarchos has joined #ocaml
<Anarchos> Is there a guide to use leave/enter_blocking_section when there are multiple nested calls between ocaml and C ?
smimou has quit ["bli"]
Ogedei has joined #ocaml
madroach has joined #ocaml
buluca has quit [Read error: 113 (No route to host)]
* Anarchos is idle: BRB
faxathisia has joined #ocaml
<faxathisia> Hi
<faxathisia> Does anyone know where to get or have the code for 'deptypes' from this book ? http://www.cis.upenn.edu/~bcpierce/attapl/
<faxathisia> it seems like it's not on the site, so just wondering if anyone knew where to get it
buluca has joined #ocaml
Anarchos has quit ["Vision[0.8.5-0418]: i've been blurred!"]
jnkm has joined #ocaml
Morphous is now known as Amorphous
Mr_Awesome has quit [Remote closed the connection]
yminsky has joined #ocaml
Anarchos has joined #ocaml
mordaunt has quit [Read error: 110 (Connection timed out)]
buluca has quit [Nick collision from services.]
buluc1 has joined #ocaml
zmdkrbou has quit [Read error: 110 (Connection timed out)]
buluc1 is now known as bruluca
bruluca is now known as buluca
Ogedei has quit ["ERC Version 5.0.4 $Revision: 1.726.2.19 $ (IRC client for Emacs)"]
yminsky has quit [Read error: 110 (Connection timed out)]
buluca has left #ocaml []
yminsky has joined #ocaml
<Anarchos> i made an interface between C and ocaml and i get a segment violation. How investigate this kind of problem ?
yminsky has quit []
jlouis has joined #ocaml
robyonrails has quit [Read error: 104 (Connection reset by peer)]
robyonrails has joined #ocaml
<Smerdyakov> Anarchos, gdb may help.
random_infinity has joined #ocaml
<Anarchos> Smerdyakov i am debugging but it stops always in caml_oldify_local_roots
<Anarchos> and i get a foolish pointer
<Smerdyakov> Also, you can try valgrind.
<Anarchos> what is valgrind ?
<Anarchos> oh it is a threaded buggy code debugger
<Anarchos> but i am on beos so no valgrind :)
random_infinity has left #ocaml []
<Anarchos> Smerdyakov my problem is that i interfaced ocaml with C++ API of beos, which is multithreaded...
<Anarchos> i protected by semaphores the acces to the GC, anyway it seems the GC of thread 1 moves objects related to thread 2
jlouis_ has quit [Read error: 110 (Connection timed out)]
<pango> you could use a receipe I've seen used by some C++ coders when it comes to multithreaded programs bugs: add pause()s until the crashes/memory corruption/... disappear (for a while, at least)
<Anarchos> pango i think i can make caml_oldify return immediately for other thread than the father one ?
<Anarchos> pango anyway it doesn't solve the problem ...
<Anarchos> pango or i can force each thread to have its own caml heap space ?
<Anarchos> i was so happy to have been able to go so far : i program the whole graphical api of beos through ocaml code :)
<pango> for the last question, the answer is, as far as I know, "no"
<Anarchos> pango what a shame the multithread GC of camllight have been abandoned, now so many multicores chips are appearing...
<malodios> many softwares were for single core chips
<Anarchos> malodios i know, but in my point of view, the multithreaded code brings so appealing challenges for a researcher that the ocaml team should not withdraw it because of the small improvment of performance
<flux> anarchos, I used to think so too, but now I'm thinking that erlang's "share nothing"-approach might be more scalable
<flux> even though "shared everything" is still usable when you only have a few cores: the situation we have today
<flux> but, off to sauna ->
piggybo3 has quit ["Leaving."]
Anarchos has quit [Read error: 113 (No route to host)]
jlouis_ has joined #ocaml
robyonrails has quit [Read error: 104 (Connection reset by peer)]
zmdkrbou has joined #ocaml
pango_ has joined #ocaml
pango has quit [Nick collision from services.]
pango_ is now known as pango
jlouis has quit [Read error: 110 (Connection timed out)]
FZ has quit [Read error: 110 (Connection timed out)]
seafood has quit [Read error: 110 (Connection timed out)]
Smerdyakov has quit [Read error: 110 (Connection timed out)]
robyonrails has joined #ocaml
<orbitz> bluestorm: elisp is not all lisps though. he seems a big fan of common lisp, does that have the silent name conflicts issue?
faxathisia has quit ["Leaving"]
ertai has joined #ocaml
<hcarty> Is there a way to do locally rename a module in a class?
<hcarty> ex. class c = let module L = List in object val it = [] method get = L.hd it end;;
<hcarty> But that does not work - syntax error on "module"
<hcarty> "rename" is not the correct word/terminology...
madroach has quit [Remote closed the connection]
huh has joined #ocaml
<bluestorm> pango: i've done some performance tests
<bluestorm> and except for the actual higher-level implementation of the prettified comparison operators
<bluestorm> there is no noticeable difference between NumInt64 and plain Int64
thermoplyae has joined #ocaml
<bluestorm> so the functor doesn't seem to add that much overhead for Int64
robyonrails has quit ["Leaving"]
<pango> yes, that's when want (as I did), Int64s and ints. ints then get much slower
<pango> s/when/when you/
<pango> (a corrolary is that int64s are way slower than ints, most likely because of boxing)
<bluestorm> so the functor stuff could still be useful with Int64, Int32 and probably NativeInt
<bluestorm> wich is not that bad
<pango> or is it because of boxing? I'm not sure ints would get boxed because of the functor
<bluestorm> considering Num already provides syntaxic facilities (but of couse they could use the same as Int64)
<bluestorm> hm
<bluestorm> i could try it with floats and ints
<pango> bluestorm: yes, you can use any integer type but the fast one ;)
<bluestorm> i get a 280% slowdown with floats :)
<bluestorm> anyway, this stuff is still useful for Int64, Int32, Nativeint
<bluestorm> thus i can use every ocaml numeric type with syntaxic sugar
<bluestorm> wich is not that bad
<bluestorm> (no more "Arithmetic's readability" problems on the "OCaml Language Sucks" page)
<pango> not quite every... the idea was to use some code with int64 on 32 bit arch, and int on 64 bit arch (the one-bit discrepancy was ok)... But codes get so much slower on 64 bit arch that it was no use
<jdavis_> If I have a set, what's the easiest way to produce the power set?
<pango> Nativeint is not very useful... You rarely need "the type that's consistently the less space efficient", even when looking for portability :)
<pango> jdavis_: a recursive function, probably
<jdavis_> Ok
<jdavis_> Just making sure I'm not missing anything obvious.
<pango> power sets get quickly huge (card = 2**n), so it may be better not to "materialize" them in full (lazy lists, for example)
<jdavis_> pango: I'm trying to compute the canonical cover of a set of functional dependencies. I'm trying to figure out how I can do that without materializing too much, but it's not obvious to me.
robyonrails has joined #ocaml
<jdavis_> pango: I think it's an exponential algorithm, but I think there are some efficiencies that can be found (I don't really know what they are though).
<bluestorm> the way of producing the subsets lazily is quite elegant
<bluestorm> you represent them with numbers : a binary representation of a number < 2^n gives a powerset
<jdavis_> bluestorm: I'm figuring that out now. I'm new to ocaml, this is the first real problem that I've tried to solve.
<jdavis_> bluestorm: interesting...
<bluestorm> and there are nice ways to lazily produce every number up to 2^n
<bluestorm> the easiest one being "add one"
<bluestorm> (iirc, an other one is "gray code", simple to implement but not easy to remember)
<bluestorm> hm
<bluestorm> s/gives a powerset/gives a subset/
<jdavis_> bluestorm: that sounds like a nice algorithm. I'm going to have to think some more about how I can eliminate as many possibilities as early as possible, though.
<bluestorm> i don't know what a "canonical cover of a set of functional dependencies" is (but in case you have any url, i'd be interested)
asmanur has quit [Read error: 104 (Connection reset by peer)]
<jdavis_> it's related to database normalization.
<jdavis_> I'm trying to find a better link than that right now, but that was the first google result.
<jdavis_> that's a more general explanation.
<jdavis_> One of the difficulties is that I want to get a real canonical cover. Some of the algorithms look like they only produce an irreducible cover, and testing the equivalence of two irreducible covers is not trivial.
<jdavis_> (I should say not trivial to me, it may be trivial to someone else)
Smerdyakov has joined #ocaml
FZ has joined #ocaml
robyonrails has quit [Read error: 104 (Connection reset by peer)]
robyonrails has joined #ocaml
dmentre has joined #ocaml
dmentre is now known as dmentre_pasla
mordaunt has joined #ocaml
robyonrails has quit ["Leaving"]
ygrek has quit [Remote closed the connection]
<bluestorm> rr
<bluestorm> that [hd::tl] thing of the revised syntax is really disturbing
<bluestorm> i think that may be the only thing preventing me to use it
leo037 has quit [Read error: 110 (Connection timed out)]
leo037_ has joined #ocaml
<thermoplyae> i've been flirting with haskell for a few days after using ocaml for months
<thermoplyae> i'm not sure how i feel about lots of the language's features, but type classes seem like a swell idea
<thermoplyae> is there a reason that ocaml doesn't employ them? were they just not around at the time? i suppose it does make the typing system significantly different
<bluestorm> adding type classes is a very complex task
<bluestorm> and you add a lot of complexity to the language itself
<bluestorm> thermoplyae: see for example the error messages of ghci : really awful
<pwnguin> what's the way most people use to writeoutput to the terminal?
<thermoplyae> it's true, they're pretty terrible
<pwnguin> the print_type functions are kinda... weak
<bluestorm> thermoplyae: i heard haskell people say that SML modules and type classes were of equivalent expressiveness
leo037_ is now known as leo037
<bluestorm> pwnguin: printf
<bluestorm> (at least i use printf)
<pango> pwnguin: Printf ?
<bluestorm> thermoplyae: i you haven't, you should try modules and functors
<pwnguin> alrighty
<bluestorm> they're significantly more powerful than Haskell's ones
<bluestorm> and, although they're a bit heavy to use, they allow things comparable to type classes
<thermoplyae> i came close to using modules for something, objects ended up fitting the task better. i'll have a peek
<bluestorm> (modularity-wise)
<thermoplyae> mostly i like the restricted polymorphism that type classes allow
<bluestorm> there has been some studies of adding polymorphism to OCaml
<bluestorm> see GCaml
<thermoplyae> i'll wander through those and come back with more intelligent questions
<thermoplyae> thanks
<bluestorm> (this talk is very interesting imho but there is very little information given : is it actually usable somewhere ? are INRIA people still working of that ?)
<pwnguin> i imagine it's up to intel
<bluestorm> it's deceiving that the communication is so poor
<bluestorm> this point of view on functors is really similar to type classes
<thermoplyae> this presentation looks really promising
<thermoplyae> it's missing one or two things, like it forces resolution. doesn't have the Num a => a -> a -> a sort of thing that haskell has going on
<bluestorm> hm
<bluestorm> the solution would be to put all functions depending on Num in a functor on the Num signature
<bluestorm> thermoplyae: but there is no such "Num" common interface in ocaml, because it really kills numeric performances and ocaml is quite low-level on such things
<thermoplyae> speed is a reasonable argument too
<bluestorm> in case you're interested
<bluestorm> i have tried to do something like that this morning : http://bluestorm.info/ocaml/numeric/numeric.mli.html , http://bluestorm.info/ocaml/numeric/numeric.ml.html
<bluestorm> but functors are usually used on much higher-level grounds than "Num"
<thermoplyae> not having made serious use of modules/functors, i'm interested
<bluestorm> the .mli describe the modules interface, in the .ml you have the real implementation
<bluestorm> the idea was to provide a common numeric syntaxic sugar (so that you can use for example (+.) notations on Int64, Int32, not only floats)
<bluestorm> to that purpose i defined a NUMERIC signature, for wich you can provide modules (NumFloat NumInt64 are examples of such modules)
<bluestorm> and you can provide only NUMERIC_BASE modules, and have the Numeric functors derive them automatically into NUMERIC modules
<thermoplyae> so what's the downside?
<jdavis_> How do you declare mutually recursive functions, like "let f x = 1 + g x;; let g x = 1 - f x;;"
<bluestorm> jdavis_: let rec f = ... and g = ...
<bluestorm> (no "rec" after and)
<jdavis_> bluestorm: oh, ok. thanks.
<bluestorm> thermoplyae: computations using that module are _very_ slow with floats, must be slow with ints too (but i have no tested it)
<bluestorm> because the compiler do some clever unboxing or function specializations on basic types, and the higher-order module interface prevent them
<thermoplyae> is it known what causes the overhead? i've heard tell that speed issues are common with functors
<thermoplyae> mm
ahnfelt has joined #ocaml
<bluestorm> but on Int32, Int64 or such non-optimized types, there is no noticeable overhead
<ahnfelt> Is there any way to pretty-print a custom tree (algebraic datatype)?
<Smerdyakov> bluestorm, no boxing with Int32 on amd64, right?
<ahnfelt> Short example: print Some (Some ("String")) would output "Some(Some("String"))"
<bluestorm> Smerdyakov: hm
<bluestorm> dunno
<bluestorm> ahnfelt: you can code such a function yourself
<bluestorm> and i guess you may try to code a camlp4 filter that would derive such functions automatically, but i would except it to be non-trivial
<bluestorm> there is no standard way to do that for any algebraic datatype
<ahnfelt> whew, I'd rather not venture into camlp4 for it
<ahnfelt> ok, thank you :)
<bluestorm> hm
<bluestorm> the Deriving project may handle that actually
<Smerdyakov> Jane Street has released a camlp4 library that will generate converters to and from S-expressions for OCaml type definitions.
<Smerdyakov> So, you can convert your values to S-expressions, and the S-expressions to nicely-indented strings.
<bluestorm> Smerdyakov: true
<bluestorm> and with that library come a little camlp4 thing that seems to allow one to define type-deriving functions easily
<bluestorm> but i haven't looked at it yet
<ahnfelt> thank you, I'll take a look at them
<ahnfelt> the reason I thought such a thing would exist already is that the interpreter happily does it
<Smerdyakov> The REPL isn't an OCaml function at the same level as the programs it compiles.
<ahnfelt> I think I'll go ahead and write my own pretty printer then (it's for a small language, and then I'll have a formatting tool)
<bluestorm> Smerdyakov: do you know if the Ocaml Summer Project students have kept their projects alive since then ?
<Smerdyakov> bluestorm, I think most haven't.
<bluestorm> that's a shame
<Smerdyakov> bluestorm, if you have any suggestions for what if anything we should do this year along the same lines, bring 'em on. :)
<Smerdyakov> (This goes for everyone here.)
<bluestorm> hm
<bluestorm> from an exterior point of view, the last year organization went quite well
<bluestorm> i'd happy to see the same thing happen again
<ahnfelt> How about more detailed syntax error messages?
<Smerdyakov> ahnfelt, you're proposing a particular project? Do you know what the OSP was?
<ahnfelt> Oh, sorry, I was mistaking it for google summer of code for ocaml
<bluestorm> Smerdyakov: i'd personally interested in more information during development of the projects, but it seems it's a student-related problem
<bluestorm> hm
<bluestorm> you may look for a common platform to host their projects, though
<Smerdyakov> ahnfelt, if I understand what you mean, that's pretty much what it is.
<Smerdyakov> ahnfelt, I was asking for suggestions for how we should run the program, not for particular projects.
<Smerdyakov> ahnfelt, (I work at the company that ran it)
<ahnfelt> ah ok :)
<bluestorm> perhaps a dedicated webpage with some pre-made template (presentation / blog / documentation) and a git/darcs/svn repository would encourage them to give more informations
<bluestorm> and make it easier for them to maintain the project after the end of the summer
dmentre_pasla has left #ocaml []
dmentre_pasla has joined #ocaml
<bluestorm> ( do you think the lack of actual maitainance was related to a particular aspect of last-year organization ? (i'm not sure you were working there at that time) )
<Smerdyakov> I wasn't.
dmentre_pasla has quit ["Leaving."]
leo037 has quit ["Leaving"]
<bluestorm> Smerdyakov: are you still linked to your old academic environment ?
<bluestorm> i mean, do you plan to give lectures or things lake that in the future ?
<hcarty> Smerdyakov: Encouraging outside collaboration/sponsorship may help long(er) term upkeep of OSP code
<hcarty> The student could still keep the money, do the presentation, etc. Just someone else with a direct interest.
<Smerdyakov> hcarty, we had a suggestion to get professors are mentors.
<Smerdyakov> bluestorm, I hope to submit to the same old conferences again.
* Smerdyakov disappears for a bit.
<bluestorm> (can't be !)
jlouis has joined #ocaml
jlouis__ has joined #ocaml
jlouis_ has quit [Read error: 110 (Connection timed out)]
Chile` has joined #ocaml
ahnfelt has quit ["Ex-Chat"]
jlouis has quit [Read error: 110 (Connection timed out)]