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
lief_ has joined #ocaml
lief_ has left #ocaml []
lief has quit [Read error: 110 (Connection timed out)]
jeanbon has quit ["EOF"]
Ariens_Hyperion has quit []
slash_ has quit [Client Quit]
bzzbzz has quit ["leaving"]
<thelema> palomer: I don't understand why you find that function cool, but go ahead and enjoy it.
<thelema> as to your first question... Batteries has a UTF8.enum function that makes an enumeration of characters out of a UTF8 string
<thelema> (unicode characters, of course)
wsmith84 has quit [Read error: 60 (Operation timed out)]
det_ has quit [Remote closed the connection]
sgnb has quit [Remote closed the connection]
sgnb has joined #ocaml
<delroth> does anyone here knows how I could make a C function returning an OCaml object ?
<thelema> not easily. Is there another way to do what you want?
<thelema> s/another/any other/
<delroth> I tried to figure out how I could do that, but did not find any other way
<delroth> the only other solution I found is really hacky
<thelema> your c function could call an ocaml function that actually creates the object?
<thelema> or the other way around - the c function could return the parameters needed to construct the object in ocaml
<delroth> in fact I'm wrapping a C++ library and wants to return an already constructed object
<delroth> my OCaml classes all have a field called __inst which is a pointer to the underlying C++ object
<delroth> I would like to have something like __inst_type -> 'a to convert my C++ object to an OCaml object
<delroth> but well, it sounds like impossible
<thelema> hmm... I don't think that's a reasonable conversion...
<thelema> Especially as you'd have to get the right info into the type system in order to even use such a function
<thelema> hmmm...
<thelema> an ocaml method call is just a dynamic dispatch function call with the object as first argument - can you dispatch like that in your C++, to simulate the ocaml object dispatch?
<delroth> hm...
<delroth> I may be able to but it's probably going to be unmaintainable
<thelema> yup, if you're not dealing with a fixed target, I wouldn't even try
<delroth> the other solution is to think again my class architecture, to be able to create an object using directly the cpp pointer as a constructor argument, and have a class which inherits from it taking the correct constructor arguments
<delroth> class _internal_c inst = object val __inst = inst end;; class c a b = object inherit _internal_c (constructor a b) end;;
<delroth> but well, I would be forces do downcast _internal_c instances to c instances
<delroth> forced*
<delroth> to*
wsmith84 has joined #ocaml
<delroth> thelema: do you think in this case using Obj.magic would be safe ?
<delroth> at least it does not segfault on my simple test cases, but I wonder if it will on more advanced classes :/
<delroth> (my test code, replacing the C++ inst with an int, is http://paste.pocoo.org/show/113315/ )
<thelema> no
<delroth> it won't be safe, or it won't segfault ? :)
<thelema> I'm still trying to figure out how you think you'll go from the C++ object representation to the ocaml object representation
<delroth> I don't
<thelema> why do you need obj.magic at all for this example?
<thelema> and what do you think you gain from the two classes?
<delroth> my OCaml object will just keep a reference to the C++ object and pass it to plain functions which are calling the underlying methods
<delroth> for example, if I have a class C with a method foo taking an int and returning an int
<thelema> if you're just going to use plain functions, why would you need an ocaml object?
<delroth> to keep the original library interface
<delroth> I'll have a C++ wrapper function, external __c_foo : __cppinst -> int -> int = "ml_c_foo"
<thelema> it sounds more appropriate to use a value tagged Abstr
<delroth> and my class C will be in OCaml class c = object val __inst = __construct_c_inst () method foo i = __c_foo i end
<delroth> thelema: that's what my __cppinst is
<thelema> will your ocaml class have any methods? (other than that getter?)
<delroth> it will only have methods provided by the C++ interface and called through the C++ wrappers
<thelema> ah, I see - you'll write all your methods to just call the C interface to the C++ method calls.
<delroth> yep
<delroth> the problem is when I have a C++ function returning an instance of the C class
<thelema> okay, so back to obj.magic, why would you need/want that?
<delroth> well, 'cause in my example _c1 does not inherit from c1, it's c1 which is inheriting from _c1
<thelema> you want to magic it into an ocaml object?
<delroth> it's not upcasting, it's downcasting
<thelema> in your example it's fine because c1 doesn't have any new methods
<delroth> it won't, everything can be provided by _c1
<delroth> c1 only provides the constructor
<thelema> then why have c1?
<thelema> you don't need c1 for the constructor
<thelema> let c1 x = new _c1 (constructor x)
<delroth> well, but it's unreadable and it obliges me to make the constructor wrapper public
<delroth> oh, no, ok
<delroth> well, I may try that
<delroth> the problem is that in this way there is no more the "new" keyword when I create an object
<delroth> but it should not be a problem
<thelema> let new_c1 x = ...
<delroth> :)
<delroth> ok, thanks
<thelema> and why not put the constructor into _c1?
<delroth> 'cause I need both a way to construct it with normal parameters and with an already existing instance
<thelema> ok.
m3ga has joined #ocaml
kaustuv has joined #ocaml
AxleLonghorn has joined #ocaml
wsmith84 has quit [Remote closed the connection]
<mrvn> delroth: you can define a virtual class as base and 2 sub classes with different constructors
<mrvn> or a class type and 2 implementations.
<mrvn> The big question is how you want to implement dynamic_cast<...>().
wormphlegm has joined #ocaml
AxleLonghorn has left #ocaml []
<kaustuv> The type 'a option is not as efficient as possible. Here's an alternative: http://ocaml.pastebin.com/d84a3221
<kaustuv> Or perhaps not...
<flux> argh, you've brought the dreaded NULL to ocaml :)
<kaustuv> Yeah, together with seg faults, apparently.
* thelema sees segfaults, and wants to see benchmarks
Associat0r has joined #ocaml
<kaustuv> OK, I think I learned an important lesson here: it's impossible to distinguish between the value 0 and null without an extra box.
<flux> well, there is the tag number, but even if that worked, a type like 'a ptr ptr wouldn't
<kaustuv> OK, here's a type-safe version, but with limited functionality. http://ocaml.pastebin.com/d4448ab80
pants2 has joined #ocaml
pants1 has quit [Read error: 60 (Operation timed out)]
wormphlegm has quit []
<mrvn> Instead of passing NULL back from C/C++ to ocaml throw an exception.
<mrvn> Unless that is a common return valuen in which case use an option.
komar_ has joined #ocaml
<kaustuv> certain reddit posters seem to have a strong allergy to Jon Harrop
<m3ga> he's not popular in comp.lang.functional either
<m3ga> ie usenet
<kaustuv> I didn't think that the claim "it is difficult to reason about the runtime memory consumption of Haskell programs" was controversial.
<kaustuv> But I guess this is #ocaml so I'll shut up
<m3ga> no, but the way he interacts with others can easily and not unreasonablu be interpreted as trolling
<flux> perhaps he wouldn't be considered troll (with his current behavior) if it wasn't for his past
<m3ga> is his current behaviour much better than in the past? i first became aware of him when i started using ocaml in 2004. i considered him a pain in the neck from the beginning.
Camarade_Tux has joined #ocaml
_zack has joined #ocaml
Asmadeus has quit ["Reconnecting"]
Asmadeus has joined #ocaml
det has joined #ocaml
m3ga has quit ["disappearing into the sunset"]
Yoric[DT] has joined #ocaml
verte has joined #ocaml
hkBst has joined #ocaml
m3ga has joined #ocaml
<mellum> kaustuv: huh? 0 as int is represented as 1, AFAIK. So it is distinguishable from NULL.
<mrvn> I'm still not sure if that was a wise decision.
<mellum> I'd done it differently.
<mellum> It makes arithmetic more complicated, whereas you could shove off the offset on pointers with a constant offset for free on most architectures.
<mellum> But that would make passing pointers around to/from C more complicated.
LeCamarade has joined #ocaml
<mrvn> Pointers are usually accessed with an offset anyway, so taging them with 1 wouldn't cost anything. On the other hands ints with tag cost extra opcodes.
<mellum> And there are some architectures without offsets on pointers... ia64 I think
<mrvn> mellum: On the other hand many archs have pointer access with shifted offset.
LeCamarade has quit [Client Quit]
LeCamarade has joined #ocaml
Fullma has quit []
Yoric[DT] has quit ["Ex-Chat"]
T_S_ has quit [Read error: 104 (Connection reset by peer)]
ztfw has joined #ocaml
mrvn has quit [Remote closed the connection]
mrvn has joined #ocaml
deech has quit [hubbard.freenode.net irc.freenode.net]
jeremiah has quit [hubbard.freenode.net irc.freenode.net]
jeremiah has joined #ocaml
deech has joined #ocaml
rwmjones_ has joined #ocaml
<kaustuv> mellum: there is no way to create the NULL pointer from inside ocaml as far as I can see
ztfw` has joined #ocaml
<mellum> kaustuv: Yeah, you'd probably have to write a .c for it
ztfw has quit [Read error: 110 (Connection timed out)]
<mellum> Of course, ideally the compiler would just do this optimization by itself, but that'd break the C interface... oh well
m3ga has quit ["disappearing into the sunset"]
jeanbon has joined #ocaml
OChameau has joined #ocaml
ztfw`` has joined #ocaml
ztfw` has quit [Read error: 110 (Connection timed out)]
l_a_m has quit ["Lost terminal"]
verte has quit [Read error: 110 (Connection timed out)]
Ariens_Hyperion has joined #ocaml
l_a_m has joined #ocaml
gim has quit []
gim has joined #ocaml
kaustuv_ has joined #ocaml
Ariens_Hyperion has quit []
Spiwack has joined #ocaml
kosmikus has joined #ocaml
Alpounet has joined #ocaml
jeanbon has quit ["EOF"]
jeanbon has joined #ocaml
th5 has joined #ocaml
<th5> I was wondering if any one has an idea how to do the following: make a function, f : 'a -> string, where f outputs the type of its input.
<th5> Is this information even available at run-time?
<th5> Is typing information "lost" at compile-time?
<flux> th5, there are approximations, but in general it is not possible to write that kind of function
<flux> because typing information is not preserved
<th5> ok
<Spiwack> It's sort of the purpose of the data model of OCaml actually
<Spiwack> you have a uniform representation of your data
<Spiwack> (with a slight exception for float arrays)
<Spiwack> then typing ensures you won't access memory zone that do not exist
<Spiwack> then at runtime you never care about the type of your data anymore
<th5> that makes sense
<th5> i'm surprised how little i know about the ocaml compiler (compared to a C compiler)
<Spiwack> There is a fairly good report from Xavier Leroy from back before OCaml
willb has joined #ocaml
<Spiwack> That explains a first version of the runtime of what would become OCaml
<Spiwack> http://gallium.inria.fr/~xleroy/publi/ZINC.pdf <= I think it's this one
<th5> thanks - i was just looking through his page trying to find it
<Spiwack> It's fairly out of date, but it's the most comprehensive documentation we've got as far as I'm aware
<Spiwack> two main differences I remember is that nowadays constant constructors are not blocks, and objects are not realised the way he suggests.
<th5> oh ok
<th5> should be fine for me - i'm looking for a general "base" so that ocamlc becomes less magical
<Spiwack> I've learned a lot by playing with Coq compiler too :p
<th5> gah
<th5> a fools errand
<Spiwack> It's mostly undocumented as far as I remember
<Spiwack> Well, had to ;)
<kaustuv_> A (normal) function of type 'a -> string can basically not examine its argument.
<th5> arnaud ?
<Spiwack> But it's fairly simple, one just needs to avoid reading to much the fixpoint and match compilation
<Spiwack> (yep that's me)
* th5 is Tom - working down in Sophia
<th5> under yves
<Spiwack> I knew that 'cause whois just rocks :p
<th5> heh - good old irc
lanaer has joined #ocaml
kelaouchi has quit ["leaving"]
kelaouchi has joined #ocaml
_andre has joined #ocaml
<mellum> Hmm, I'm trying to write a function returning the index of the maximum element in an array. Isn't there something simpler than http://paste.debian.net/33989/
kelaouchi has quit ["leaving"]
nimred has joined #ocaml
<Spiwack> let max_i v = let maxi a1 a2 = if snd a1 > snd a2 then a1 else a2 in let r = ref (0,min_int) in Array.iteri (fun i a -> r := maxi !r (i,a)) v
<Spiwack> That's probably a bit more economic, and probably slightly incorrect since I haven't typechecked it
<Spiwack> oh yes, forgot the " ; !r" at the end, but well :p
<Spiwack> damn !
<Spiwack> " ; fst !r "
<_andre> let maxi a = fst (Array.fold_left (fun (i,v) x -> if x > v then (succ i, x) else (i, v)) (-1,min_int) a);;
bzzbzz has joined #ocaml
<Spiwack> well this one is incorrect :p
<Spiwack> I should answer the wrong answer on [| 2;1;3 |] if I'm not mistaken
<_andre> hmm
<Spiwack> you probably need a third element in your tuple if you want to use fold
<Spiwack> to keep track of the current index
<_andre> yeah... i first read that he wanted the max value, not the max index, and then i figured it'd be just an snd->fst change :p
Yoric[DT] has joined #ocaml
Ariens_Hyperion has joined #ocaml
<Spiwack> the max value would be actually simpler as it's just Array.fold_left max min_int v :p
<hcarty> mellum: A very imperative approach: http://ocaml.pastebin.com/d40a61935
<Spiwack> (associativity for t3h win)
<Ariens_Hyperion> what if the array is empty?
<Ariens_Hyperion> does it return min_int?
nimred has quit [Client Quit]
<Spiwack> well, the neutral element of max is -infinity, but min_int is a good approximation, isn't it?
nimred has joined #ocaml
<Ariens_Hyperion> the neutral element of max?
<Ariens_Hyperion> is there a neutral element for max
<Spiwack> Well, if you have the negative infinity at your disposal then there is :)
<Ariens_Hyperion> relying on min_whathever to program max/min functions is extremely sloppy IMO
<Spiwack> if you are in the natural numbers 0 is a neutral element for max as well
<Ariens_Hyperion> yeah
<Ariens_Hyperion> max [] = o?
<Ariens_Hyperion> that sounds right
<Spiwack> if everything is positive that's cool
<Spiwack> non-negative rather
<Ariens_Hyperion> tha is a mistake
<Yoric[DT]> hi\
<Yoric[DT]> hi
<Yoric[DT]> hcarty: semi-pon g
<Yoric[DT]> hcarty: semi-pong
* Yoric[DT] seems to have issues with his keyboard, today.
Amorphous has quit [Read error: 104 (Connection reset by peer)]
<hcarty> Yoric[DT]: Now if I can just remember why I pinged you in the first place :-)
<Yoric[DT]> :)
<hcarty> I think it was for the GZip vs Gzip naming question, and a Batteries porting pitfalls discussion
<hcarty> Yoric[DT]: thelema was kind enough to help make some revisions to the text here -- http://etherpad.com/eLvWqhVq5L
* Yoric[DT] will try and read all of this tomorrow.
<Yoric[DT]> (today, I'm preparing tomorrow's 10 hours-long project/exam)
<hcarty> Yoric[DT]: Sounds good to me, thanks
<hcarty> Have fun!
<Yoric[DT]> thanks
Ariens_Hyperion has quit []
th5 has quit []
Amorphous has joined #ocaml
<palomer> hrmph, anyone have any idea how to make strings underlined/italic in camomile?
jeanb-- has joined #ocaml
jeanbon has quit [Nick collision from services.]
jeanb-- is now known as jeanbon
jeremiah has quit [Read error: 104 (Connection reset by peer)]
_zack has quit [Remote closed the connection]
_zack has joined #ocaml
rwmjones_ has quit [Read error: 104 (Connection reset by peer)]
jeremiah has joined #ocaml
_zack has quit [Client Quit]
jonafan has joined #ocaml
<hcarty> Yoric[DT], thelema: Any thoughts/comments on the GZip -> Gzip module rename? Is it too late to make such a change?
mjonsson has quit [Read error: 60 (Operation timed out)]
<Yoric[DT]> I believe it's acceptable.
<flux> why was it renamed the other way in the first place?-o
<Yoric[DT]> We just need to make sure to document this.
<_andre> does anyone know of a code coverage tool for ocaml?
<Yoric[DT]> flux: by accident
<gl> andre, ocaml-bisect maybe?
<_andre> gl: i remember trying it once but i couldn't make it work
<_andre> maybe i'll give it another try
LeCamarade has quit ["Gone."]
rwmjones_ has joined #ocaml
<hcarty> Yoric[DT]: Ok, I have a patch to do the renaming which should (I think) work
<hcarty> Seems to work here. Is the Extlib.Foo.* typing for G[Zz]ip normal in Batteries? Is this something I can fix simply in this patch?
<Yoric[DT]> Not yet.
Spiwack has quit ["Leaving"]
<hcarty> Renaming GZip to Gzip breaks compilation of examples/tools/gzip.ml
<hcarty> Circular build detected\n (gzip.cmi already seen in [ gzip.cmi; gzip.cmx; gzip.native ])
<flux> heh
ttamttam has joined #ocaml
<hcarty> flux: Indeed :-)
<hcarty> Any suggestions for a different name for the gzip.ml example?
<hcarty> gnuzip perhaps? That's awfully close to gunzip though.
<flux> gzipExample :)
<flux> but I wonder why it breaks anything though
<flux> because of the automatic opening of Batteries?
<flux> hm, can't be that
<flux> aren't examples compiled in isolation of the real batteries
<hcarty> flux: I think it's either an OCaml or ocamlbuild limitation
<flux> hcarty, is there gzip.cmi around when using batteries?
<hcarty> Trying to make a file map.ml and compile it (contents
<flux> because there shouldn't be?
<hcarty> : let () = ()")
<hcarty> There is for the camlzip module
sgnb has quit [Remote closed the connection]
sgnb has joined #ocaml
<hcarty> Which is used by Batteries in GZip/Gzip
<flux> hmm.. indeed, that might cause a problem
<flux> but why wouldn't it have caused it earlier
<flux> renamind should not affect that at all
<flux> renaming even
<hcarty> The module was called GZip, so it was gZip.cmi instead of gzip.cmi
<hcarty> No, sorry
<hcarty> You're correct
<hcarty> Does anyone here have a Batteries install to test this?
<hcarty> Otherwise I can build from a clean Batteries tree
<flux> sorry, no (not yet anyway)
<Yoric[DT]> Test what ?
<Yoric[DT]> A map.ml?
<hcarty> Yoric[DT]: Compiling examples/tools/gzip.ml
<_andre> gl: bisect worked :)
* Yoric[DT] pulls
<Yoric[DT]> hcarty: er... there's nothing to pull, is that normal?
<hcarty> Yoric[DT]: Yes, sorry
<hcarty> I'm looking for a comparison from a vanilla Batteries
<Yoric[DT]> So what do you want me to do?
<hcarty> It seems to fail here for vanilla Batteries as well
<Yoric[DT]> Just compile examples/tools/gzip.ml ?
<hcarty> Yoric[DT]: Yes, if you have time
<Yoric[DT]> ok
<hcarty> To see if you get a circular build error
<Yoric[DT]> wfm
<Yoric[DT]> ocamlfind batteries/ocamlbuild gzip.byte
<hcarty> Yoric[DT]: Thanks, it must be a problem here. I'll have to track it down.
<Yoric[DT]> np
<Yoric[DT]> Good luck.
<hcarty> Yoric[DT]: Thanks. I think I know what the problem is.
<Yoric[DT]> ok
<hcarty> It's broken here with the rename and works without the rename
<Yoric[DT]> The rename?
<hcarty> Perhaps I should just leave the files as they are and only change the threads/batteries.ml and nothreads/batteries.ml?
<hcarty> Yoric[DT]: Renaming gZip.* to gzip.* and related source changes
<Yoric[DT]> ah, ok
<Yoric[DT]> Perhaps that's the easiest thing to do.
<mfp> hcarty, Yoric[DT]: may I push the OUnit testsuite patches to master?
<Yoric[DT]> I haven't had time to review it.
<Yoric[DT]> Has someone done so?
<mfp> maybe zack, not sure
<Yoric[DT]> I can try and review it tomorrow.
<mfp> anyway all they do is use OUnit instead of Testing
<Yoric[DT]> Today, I'm in exam-deadline mode.
* Yoric[DT] is also running out of subjects.
<mfp> no other changes to the tests themselves (besides some redundancy removal)
<mfp> k
* mfp rebases the patches meanwhile, since one test has already changed in master
<mfp> actually hmm
<mfp> is there a policy regarding rebasing vs. merging?
<Yoric[DT]> I believe we're supposed to rebase.
<mfp> iow. is linear history preferred, or explicit branches & merging
<Yoric[DT]> Ask thelema :)
<mfp> thought so, but gitk shows many merges
<mfp> and some done by thelema in fact :)
<mfp> Committer: Eric Norige <thelema314@gmail.com> 2009-04-17 06:47:20 Merge commit 'origin/paolo_donadeo/master'
willb has quit [Read error: 110 (Connection timed out)]
<hcarty> Drat! Same circular dependency error
<hcarty> Any insights? The patch is here: http://ocaml.pastebin.com/d39b63f63
Hydrant has joined #ocaml
<Hydrant> hello all... I'm thinking of learning OCAML, and want to chat a bit... I've learned Haskell before, and have played a bit with SML
<Hydrant> in particular I'm curious how OCAML rates compared to other functional language... I noticed that the wikipedia entry said I can issue imperative commands also
<Hydrant> that seems strange to me for a functional language
<mfp> Hydrant: OCaml is impure
<Hydrant> what does that mean ?
<hcarty> Hydrant: OCaml supports functional, imperative and OO programming styles
<Hydrant> I see
<Hydrant> is there a standard book on OCAML?
<Hydrant> I swear I saw an O'Reilly one before, but it looks like it was my imagination
willb has joined #ocaml
<Hydrant> thx
<mfp> Hydrant: OCaml has features that break referential transparency (ref, mutable record fields, IO performed directly and not wrapped in a monad or continuation-based, etc.)
<hcarty> The manual is reasonably well written, and there is a yet-to-be-published book by Jason Hickey which is good - http://www.cs.caltech.edu/courses/cs134/cs134b/book.pdf
<Hydrant> someone today suggested that graph algorithms are extremely difficult to express in functional languages, I never would have thought that was the case... I still don't think it is
<gl> he's quite wrong
<Hydrant> he was an idiot
<Hydrant> he was convinced you needed mutable memory to be able to do most graph algs
<mfp> hcarty: fwiw., I can reproduce the Circular build detected error
<Hydrant> another lanuage I'm looking at is erlang... is anyone familiar with that one as well? I think I'll learn both of them... my goal is to look at ways of expressing data parallelism in an abstract fashion, and functional programming is likely the way to do it
<hcarty> mfp: With the patch or without?
<mfp> hcarty: goes away if I rename gzip.ml
<mfp> with
<mfp> seems whatever detects the circular build doesn't like to have both Batteries' and the main Gzip at once
<hcarty> mfp: Ok, thanks. Same workaround here - renaming gzip.ml to gnuzip.ml fixes the problem.
<mfp> Hydrant: do you want to parallelize for performance?
<Hydrant> yah, that's the idea
<Hydrant> I'm doing parallel programming research
<Hydrant> task parallelism is one thing, but I'm looking at pure data parallel operations
<Hydrant> well... not completely pure
<gl> i guess erlang is much more appropriate for you then
<hcarty> Hydrant: ocamlp3l and jocaml are examples of similar work in OCaml land
<mfp> then you probably don't need Erlang --- it excels at concurrent stuff, not data parallelism
<gl> oh, yes, concurrency
<Hydrant> I'm going to look at both of them
<Hydrant> the atomic ocaml looked interesting
<gl> did someone here is familiar with jocaml?
<mfp> iow. getting a 8X speedup thanks to the 8 cores is not very useful if serial execution is 100X slower to begin with...
<Hydrant> are there other functional languages I'm missing out on? Maybe haskell ?
<mfp> Haskell is more sensible a choice than Erlang if you want performance and only need to scale to a few cores
<Hydrant> I think haskell, ocaml, and erlang would be a sensible survey of functional programming
willb has quit [Read error: 60 (Operation timed out)]
<Hydrant> well, I'm looking at general approaches.... not particular applications right now
<Hydrant> eventually I'd like to integrate such an approach with GPU programming
<mfp> (little gains in Haskell after 4 cores or so, because the GC is not concurrent)
<Hydrant> oh yah GC... I suppose most functional languages would have that
<Hydrant> it's a pain in the arse to do concurrently
<Hydrant> unless you have thread-local pools of memory
<mfp> I believe they want to add that to GHC at some point, but it's not there yet
<Hydrant> GHC?
<gl> haskell compiler
<mfp> and AFAIK there's nothing comparable to JoCaml's joint calculus in usable form in Haskell-land
<Hydrant> is anyone familiar with pi-calculus? I've wondered how a functional language based on pi-calculus would differ from one based on lambda calculus
* Hydrant is going through a book on lambda calclus righ tnow
<mfp> Hydrant: if you don't need code mobility, JoCaml could be of use http://jocaml.inria.fr/ <- OCaml + join calculus
<Hydrant> interesting
<mfp> IIRC Yoric[DT] is, but he's in exam-deadline mode atm.
<Hydrant> realistically I would have to implement a functional language myself for some of the strange hardware I'm looking at
<Yoric[DT]> pi-calculus is fun
<Yoric[DT]> still, deadline :)
<Hydrant> or at least the compiler back-end for it
<mfp> JoCaml is not as convenient as GHC's parallelism (since you have to launch the processes & register channels), but it scales better (since each process gets its own heap, no pb with the GC) + across machines
<Hydrant> is there much research into optimizing compiler for functional languages?
ttamttam has left #ocaml []
mikaz has joined #ocaml
<hcarty> Hydrant: I don't know what sort of research is involved, but I think both GHC (Haskell) and mlton (SML) pride themselves on their optimizations
willb has joined #ocaml
kosmikus has left #ocaml []
_andre has quit ["Lost terminal"]
<kaustuv_> Hydrant: google the PICT language by Benjamin Pierce et al
<Hydrant> thx
grirgz has joined #ocaml
vuln has joined #ocaml
<vuln> May I make a local variable in the scope of the next call of a recursive function?
* Yoric[DT] doesn't even understand the question.
<Yoric[DT]> Unless you're talking about dynamic scoping, in which case the answer is : not without cheating.
<grirgz> hi
<grirgz> how can i catch ctrl-c in ocaml programs ?
komar_ has quit [Read error: 113 (No route to host)]
Komar_ has joined #ocaml
<Yoric[DT]> I don't think you can.
<Yoric[DT]> It's not part of the language, it's a feature of the toplevel.
<vuln> Yoric[DT]: May you help me?
<Yoric[DT]> vuln: I strongly do not suggest dynamic scoping.
<Yoric[DT]> (plus I'm quite busy atm)
<vuln> Yoric[DT]: don't worry
<Yoric[DT]> You could take a look at
<Yoric[DT]> (it's at the end of the page)
<vuln> My problem is this: I have to check a conditional expression (a <> b), but in the next line, NOW, it might be a = b, so it means 2 ifs
<vuln> and it is not being acceptable :D
* Yoric[DT] doesn't understand.
<vuln> ok, look the code
<Yoric[DT]> You should pass [keep_track] as an argument to your function.
<vuln> but the question doesn't allow me to do that :(
<vuln> I have to check the biggest result of (f a) between a and b in a function which have three arguments: a, b and f (function)
<grirgz> Yoric[DT]: yes you can \o/
<Yoric[DT]> grirgz: how?
<Yoric[DT]> vuln: well, then you need to define a function inside your function.
<Yoric[DT]> vuln: that auxiliary function can accept different arguments (such as [keep_track])
<grirgz> try Sys.catch_break true with Sys.Break -> ()
<Yoric[DT]> grirgz: interesting
<Yoric[DT]> Thanks :)
<vuln> Yoric[DT]: I have been trying to do that for 1 day and I still can't :(
<grirgz> =)
<Yoric[DT]> vuln: what's the problem?
<vuln> Yoric[DT]: There's a function f (int -> int) and a function maximizer (int -> int -> (int -> int) -> int)
<vuln> Maximizer has three arguments. a, b and f (the function f I declared before)
<Yoric[DT]> vuln: no, I mean, what's *your* problem?
* Yoric[DT] is definitely not going to do the exercise :)
<vuln> haha
<vuln> I tried to do in 100 different ways, but ALWAYS I'm comparing (a) with (a+1). (a+1) with (a+2). And I didn't find a way to compare (max (a) (a+1)) with (a+2)
<vuln> =/
<vuln> any suggestion to help me?
<hcarty> vuln: If this is homework, then you should probably ask the instructor for assistance
<vuln> hcarty: He is out town and passed a huge list of recursion exercises to we do while he's out
<gl> he's probably at tahiti right now, under the sun
<vuln> hahaha
<vuln> gl: He's too white to take a sun
<vuln> :P
<hcarty> vuln: You could try writing it in a non-recursive (imperative) manner
<vuln> hcarty: That's the problem
<kaustuv_> oracle bought sun anyway
<hcarty> vuln: Then adapt that approach to recursion
<gl> yeah right, ocaml instructor, i forgot.
<vuln> I can figure out a lot of ways to do it with: extra function, extra paramater, mutable variable, non recursive manner
<kaustuv_> though being under an oracle would be kind of neat too
<vuln> But I have to do EXACTLY as the question says and using ONLY knowledge which he taught at the class room
<vuln> :(
<Yoric[DT]> vuln: well, first do it in any manner, then try to fit it to the question.
<vuln> and he didn't teach yet mutable values, arrays and nothing like that
<vuln> so even I know, I can't use.
<totom> in the code you pasted, you need an "else" on your first if clause
* totom has not understood the question though
<vuln> else if?
<vuln> but the problem, is that is not ELSE if. After the expression of if, it might be also the second one
<vuln> or might not.
<vuln> It depends if it reached the end of the list OR not
<gl> which list?
<totom> ?? you can use parentheses to scope your ifs
christian_ has joined #ocaml
<vuln> gl: the f -> numbers from a to b
<totom> anyway you need an else on all clauses since you return ints
<totom> so all branches have to return ints
<gl> vuln this is an interval
<christian_> Hi...why is 1 == 1 true but 1.0 == 1.0 false in ocaml?
<gl> a list is a built-in type in ocaml
<vuln> gl: sorry
<totom> christian_: float equality does not exist.
<totom> due to the way floats are represented inside the machine
<flux> christian_, 1.0 is a 'boxed value' and you are comparing for identity
<vuln> I don't want the answer, but does anyone here can solve my problem
<vuln> ?
<flux> don't listen to totom, he is confused ;)
<vuln> Just to know if I'm too dumb, or it's really hard
<christian_> What is a boxed value?
<flux> (although he has a point)
<flux> christian_, the actual value is behind a pointer
<flux> christian_, == compares those kind of pointers
<Yoric[DT]> vuln: well, I'm not 100% sure In understand the question, but I'm pretty sure you can solve it without anything mutable.
<totom> the only way to check float equality is to compute the difference and check it's smaller than a very small value
<vuln> christian_: a != b and a == b is different from a <> b and a = b
<flux> christian_, you usually want to compare for equality with =
<christian_> ah..thanx a lot...im enlightened
<vuln> Yoric[DT]: How can I save the last result to compare with the new number of the interval so?
<totom> oh, ==, my bad :-)
<vuln> If I can't pass it as parameter or save in a mutable variable?
<Yoric[DT]> vuln: pass it as parameter :)
<vuln> I can't use any extra parameter/function
<hcarty> vuln: Are you sure you can't use another function inside of maximizer?
<totom> vuln: could you please re-explain the question ?
<vuln> hcarty: inside I can, you mean as neasted function right?
<hcarty> vuln: Yes
<vuln> I just didn't find out how to make it work XD
<Yoric[DT]> vuln: first do it with the extra argument, then find a way to get rid of it.
<vuln> totom: There's two functions. f and maximizer. f (int -> int) and maximizer (int -> int -> (int -> int) -> int)
<Yoric[DT]> (by using a nested function, as mentioned)
<vuln> Maximizer has three arguments. a, b and f (the f I declared before)
<vuln> He wants the BIGGEST f applied number between the interval a -> b
<hcarty> vuln: Follow Yoric[DT]'s suggestion - that will get you a working function
<vuln> hcarty: ok, I will try it
<vuln> thanks
<Yoric[DT]> Unrelated question: does anyone know how I can simply convert an image to the format understood by module Graphics?
<totom> vuln: use recursion. Hint : the biggest f-applied is also the bigger of (f a) and the result of your function applied to some other arguments
<vuln> ok
<vuln> made
<vuln> :)
<christian_> is there any attempt on the net building an os-kernel in ocaml?
<vuln> It's working
<vuln> Wanna see the code?
<Yoric[DT]> christian_: there used to be something called "Desert Spring Time".
<Yoric[DT]> I don't think it's active anymore.
<vuln> The f function I created more elaborated was just for 'test' the maximizer function.
<gl> vuln you do not need to mention the type in the function declaration
<vuln> gl: I know.
<gl> the compiler will infer them
<gl> ok
<totom> now try to get rid of last_result
<hcarty> Yoric[DT]: Does camlimages have anything useful? I don't have it installed to check locally
<vuln> I just like to make it more explicit to the teacher give more points
<vuln> haha
<vuln> XD
<Yoric[DT]> hcarty: yes, I've finally found something in camlimages.
<vuln> gl: but thanks for the worry, :)
<vuln> So, now it's working using extra paramater, how can I do it WITHOUT this?
<totom> well, think a bit
<totom> what's the result of (maximizer a a f) supposed to be ?
<totom> that should let you get rid of it
<vuln> maximizer a a f?
<vuln> It would be (f a)
<vuln> since it's the biggest number of f applyed from a to a
<totom> yep, so last_result is eliminated from the first branch
<totom> for the second branch, you can make it a lot simpler.
willb has quit ["Leaving"]
<Yoric[DT]> hcarty: and it doesn't work too well...
<totom> try to get the result without looking back : the only information you have access to is the result of your function applied to a subrange of [a b] and the result of f applied to the elements of [a b]
<vuln> =/
<vuln> didn't get the point
<gl> you lost him
<Yoric[DT]> hcarty: (let's say well enough)
<totom> vuln: your function should return the max f-applied number of [a b], it shouldn't look at the "past" (what was computed when a was smaller)
<totom> try to only do it in a "forward" way
<totom> (the way with the extra argument is called "terminal recursion" ; actually it's more efficient but also hides the point)
willb has joined #ocaml
<vuln> totom: good to know
<vuln> thanks :D
<christian_> hmm...I have one qusteion left: Is there a Multiagent-system written in Ocaml?
<christian_> question
<christian_> I dont find one
<hcarty> Yoric[DT]: Best of luck... I've been using some combination of Cairo, PLplot and (labl)Gtk for displaying graphics recently. But I'm not constrained to lab/student computers, which brings interesting challenges.
<Yoric[DT]> Yeah, I'm somewhat constrainted here...
<vuln> gotta go people
<vuln> thanks for everything
<vuln> be back later
<Yoric[DT]> Cheers.
<christian_> bye
pants1 has joined #ocaml
pants3 has joined #ocaml
vuln has quit ["leaving"]
<christian_> Does someone know how a string is represented in ocaml? Is it a list of chars?
pants2 has quit [Read error: 60 (Operation timed out)]
<gl> christian it's an array of chars
<christian_> My book says its not
<christian_> Perhaps string is newly implemented...
<christian_> I dont have the source at hand at the moment so im stupid
<det> A string is it's own type in Ocaml.
<christian_> jeah...but its somehow implemented...i think in ocaml itself...so i guess its a string in principle...
<det> Internally, it is just an array of characters (I think it may even be null terminated for C FFI ease), but you cant treat it as an array.
<christian_> ah...ok
<det> IOW, String.sub != Array.sub
Ariens_Hyperion has joined #ocaml
<gl> "Thus, the string is always zero-terminated, and its length can be
<gl> computed as follows:
<christian_> ok...that is definetly about the guts :)
pants1 has quit [No route to host]
monadic_kid has joined #ocaml
<christian_> so...int and char are the only types not boxed, right?
<kaustuv_> all scalar constructors are also unboxed
<kaustuv_> and floats in float arrays or records with only float fields
<kaustuv_> and the bigarray package gives you a collection of monomorphic unboxed integer arrays
<christian_> i see...but i wonder why float is boxed...has it something to do with lack of a FPU back in the days?
<christian_> Makes no sense to me right now
<kaustuv_> On x86 double is two words long, but the ocaml runtime uses only single word "value" types
<kaustuv_> this problem no longer exists in x86-64 so we may have unboxed floats eventually
<christian_> that makes alot of sense to me..thank you
<mellum> kaustuv: they'd need a tag bit, which would make them awkward to work with
<kaustuv_> not necessarily
<mellum> well, at the moment the GC needs to know whether something is a pointer by just looking at the something
<kaustuv_> (not necessarily awkward, that is -- obviously they need the pointer tag)
<mellum> not? how would you add two numbers, then?
<kaustuv_> how do you add two tagged ints?
<mellum> kaustuv_: That's much easier, because in integer registers you have shifting and masking
<kaustuv_> if a value is in an fp register already, there is nothing to worry about. If it is being loaded from memory, you'd have to load it into an integer register first and do the shifting
<kaustuv_> but this is all speculation anyhow
<mellum> kaustuv_: doing so would be very slow
<mellum> kaustuv_: in many architectures, you cannot even move values between FP and integer registers
<kaustuv_> I doubt it would be slower than a memory round trip, especially if there's a cache miss involved
<mellum> depends on the architecture, of course
<mellum> but if the pointer is in the cache, then probably also its target
rwmjones_ has quit ["Closed connection"]
<christian_> Does someone know, if the Ocaml-implementation is model checked?
<christian_> Just to be sure
<kaustuv_> Checked for what property?
<kaustuv_> The garbage collector has a formally proven specification. That's about the only thing I'm aware of.
<christian_> Well, best would be for correct recursion
<christian_> So nothing would mess up memory
<christian_> ah..ok...in the end it would be the gC-question...
<kaustuv_> The runtime is untyped, so it can easily mess up if left to its own devices. However, the type system guarantees that the runtime won't mess up when evaluating type-safe programs.
<christian_> i see
<kaustuv_> But all bets are off if any unsafe facility or ffi is used
<christian_> whats ffi?
<kaustuv_> foreign function interface
<christian_> ah
<christian_> you said the runtime is untyped...isnt Ocaml implemented in ocaml itself?
<kaustuv_> the compiler is, but the runtime is in C
<christian_> i reason it must be well typed too
<christian_> ah
<kaustuv_> I don't know of *any* programming language that doesn't have a runtime written in C (or worse, assembler).
<christian_> i think i know pypy thats python on python
<christian_> only a guess
<gl> this name is too ridiculous to be a serious option
<christian_> :D
<christian_> but its out in the wild
<gl> stalking in the dark
<christian_> hehe....the first footsteps of an ssed ai probably
<christian_> seed
det has quit [Read error: 110 (Connection timed out)]
AxleLonghorn has joined #ocaml
willb has quit [Read error: 110 (Connection timed out)]
javax_ has joined #ocaml
Demitar has quit [Remote closed the connection]
Alpounet has quit [hubbard.freenode.net irc.freenode.net]
javax has quit [hubbard.freenode.net irc.freenode.net]
bjorkintosh has quit [hubbard.freenode.net irc.freenode.net]
Mr_Awesome has quit [hubbard.freenode.net irc.freenode.net]
r0bby has quit [hubbard.freenode.net irc.freenode.net]
Demitar has joined #ocaml
Hydrant has quit [Read error: 104 (Connection reset by peer)]
Hydrant has joined #ocaml
Alpounet has joined #ocaml
Mr_Awesome has joined #ocaml
r0bby has joined #ocaml
bjorkintosh has joined #ocaml
Camarade_Tux has quit ["Leaving"]
m3ga has joined #ocaml
sfmatt has joined #ocaml
guest1234 has joined #ocaml
<guest1234> This is a value for fsharp but I was wondering if someone could explain to me how to use this. val foldRow : ('a -> float -> 'a) -> 'a -> matrix -> int -> 'a
<Yoric[DT]> I don't know what that [int] is.
<Yoric[DT]> Ah, yeah, the row number.
<guest1234> Yes I'm trying to apply a function to each member of the row.
<Yoric[DT]> It probably goes likes this: [foldRow f acc m n]
<Yoric[DT]> this will call [f acc x0]
<Yoric[DT]> then [f (f acc x0) x1]
<Yoric[DT]> then [f (f (f acc x0) x1) x2]
<Yoric[DT]> etc.
<Yoric[DT]> where x0, x1, x2 etc. are the elements of row [n] of matrix [m]
<guest1234> ah, ok that makes sense now
<thelema> hi Yoric[DT]
<guest1234> I have a class and one of the members is 'x.getVertices(i:int)' and basically I want to return a list of adjacency pairs for the row so if i = 1 then return a list [(1,2);(1,3)] depending if a 1 was set in mij or not
<guest1234> I think I can do it now though, thanks
<Yoric[DT]> thelema: hi
<Yoric[DT]> guest1234: np
<thelema> Yoric[DT] feeling better?
<Yoric[DT]> Yep, thanks.
<thelema> still a teaching strike?
<Yoric[DT]> About 10 days of fever and a few additional days of antibiotics don't help concentrating.
<Yoric[DT]> Well, still on active strike.
<Yoric[DT]> 77th day today
<Yoric[DT]> (actually 78th day at this time of the night)
<thelema> 77 days? wow.
<thelema> yes, it's late there.
<Yoric[DT]> Well, I give an exam in about 6 hours.
<Yoric[DT]> A 10h long cooperative exam.
<Yoric[DT]> So I need to finish preparing all the questions, all the companion files, etc.
<sfmatt> Hi, struggling with basic HTML parsing using ocamlnet, would appreciate some help
<thelema> Yoric[DT]: get off IRC and get to work. :)
<Yoric[DT]> :)
<Yoric[DT]> sfmatt: sorry, never used it.
<sfmatt> damn damn, looks like the API changed but the doc wasn't updated
monadic_kid has quit ["Leaving"]
<thelema> sfmatt: same here. You can try asking a more specific question, and maybe we'll be able to help you reason through it.
<sfmatt> ok just doing a very basic example
<sfmatt> in short doc says:
<sfmatt> let ch = Netchannels.input_string s in
<sfmatt> let doc = parse ch
<sfmatt> but just with this simple example, the end result is a syntax error on the last character of the file
<thelema> what error?
<thelema> syntax error... any more info?
<thelema> maybe missing an 'in' somewhere
<sfmatt> Let me show you exactly then:
<guest1234> Yoric[DT]: If you have a second I'm still unclear on how to carry out this task. I have a member called 'x.getVeritices(i:int)' where 'i' is the row. I'm trying to return a list of each member of the row that contains a '1'. I determine if it's a '1' by calling 'get m i j = 1'. But I'm not sure how to put all of this together. Any ideas?
<sfmatt> open Netchannels
<sfmatt> open Nethtml
<sfmatt> let () =
<sfmatt> let s = "<body>Hello</body>" in
<sfmatt> (
<sfmatt> let ch = new Netchannels.input_string s in
<sfmatt> let doc = parse ch;
<sfmatt> print_string s
<sfmatt> )
<sfmatt> open Netchannels
<sfmatt> open Nethtml
<sfmatt> let () =
<sfmatt> let s = "<body>Hello</body>" in
<sfmatt> (
<sfmatt> let ch = new Netchannels.input_string s in
<sfmatt> let doc = parse ch;
<sfmatt> print_string s
<thelema> sfmatt: pastebin!
<sfmatt> )
<sfmatt> oops sorry the error:
<sfmatt> File "test2.ml", line 10, characters 2-3:
<sfmatt> Syntax error
<sfmatt> Excuses!
* thelema would boot sfmatt if he was a mod
<thelema> s/mod/op/
<sfmatt> sorry simpy newb at IRC too
<mfp> sfmatt: promise you won't do it again :) and let doc = parse ch in
<thelema> "let doc = parse ch in print_string s"
* mfp goes
<sfmatt> I swear! Spit on the ground...
<sfmatt> Thanks a lot!
<Yoric[DT]> guest1234: sorry, I'm kind of concentrated on something else.
<Yoric[DT]> Plus it's nearly 2am here.
<guest1234> Yoric[DT]: Ok thanks anyway.
<thelema> sfmatt: you can only omit the [in] for top-level [let]s
<thelema> guest1234: you could use two for loops and an accumulator
<thelema> but that's not a very functional way to do it.
jeanbon has quit ["EOF"]
<sfmatt> thanks, I barely use the top-level though