kaustuv changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | 3.11.1 out now! Get yours from http://caml.inria.fr/ocaml/release.html
julm_ has joined #ocaml
julm has quit [Nick collision from services.]
julm_ is now known as julm
r0bby_ is now known as r0bby
hsuh has joined #ocaml
Narrenschiff has quit []
<tsuyoshi> under certain circumstances you can skip the CAMLparam macros even if you are allocating
Summermute66 has joined #ocaml
Lomono has joined #ocaml
hsuh has left #ocaml []
Summermute66 has quit [Read error: 60 (Operation timed out)]
Lomono has quit [Read error: 104 (Connection reset by peer)]
<hcarty> camlidl skips the CAMLparam/CAMLreturn/CAMLlocal macros, but I think it has its own library to safely work with OCaml values.
thrasibule has joined #ocaml
blackdog has quit [Remote closed the connection]
thrasibule has quit [Read error: 60 (Operation timed out)]
ski_ has quit ["Lost terminal"]
mjs22 has joined #ocaml
ski_ has joined #ocaml
tmaedaZ is now known as tmaeda
noah has joined #ocaml
<noah> hey all, i am noticing some very strange behavior related to semicolons. it is probably just that I don't really understand how the single-semicolon works, but here goes
<noah> if i run this code (as follows) it only prints out the given data intermittently, sometimes dropping the second line
<noah> print_endline ("\n\nin if-statement bestSharpe: "^(string_of_float !bestSharpe));
<noah> print_endline ("in if-statement newFitness: "^(string_of_float newFitness)^"\n");
<noah> bestGen := Array.copy newPop.(0);
<noah> bestSharpe := newFitness
<noah> but if instead of single-semicolons i do "let () = _________ in" it works fine every time. any ideas?
caligula__ has joined #ocaml
mjs22 has quit []
<julm> noah: are you using these print_endline within an if then else ?
<noah> julm: yes
<noah> and thanks for your help!
<julm> if try to use the semi-colons with parentheses around
<noah> ok. out of curiosity, what does that do?
<julm> if true then (print blabla; print much) else (print blabla; print toto)
<noah> otherwise it thinks that the statements after the first semicon are outside the "if" block?
<julm> well there is a difference wather you use [let _ = ... in] or a semi_colon
<julm> wether*
<julm> whether*
<noah> ah, yeah, i don't think i really understand that difference
<julm> noah: yes it may change what is considered within the [then] block and the [else] block
<noah> ok, got it. that makes sense. made for some weird debugging, but i think i understand now. thank you very much julm!
<julm> you're welcome
noah has quit ["ChatZilla 0.9.85 [Firefox 3.5.1/20090811021610]"]
Lomono has joined #ocaml
Lomono has left #ocaml []
caligula_ has quit [Read error: 110 (Connection timed out)]
Modius_ has quit [Read error: 131 (Connection reset by peer)]
Modius_ has joined #ocaml
f_[x] has joined #ocaml
Snark has joined #ocaml
smimou has joined #ocaml
bzzbzz_ has joined #ocaml
bzzbzz_ has quit [Client Quit]
f_[x] has quit [Read error: 60 (Operation timed out)]
run has joined #ocaml
Lomono has joined #ocaml
Lomono has left #ocaml []
hkBst has joined #ocaml
_zack has joined #ocaml
mjs22 has joined #ocaml
mjs22 has left #ocaml []
mjsor has joined #ocaml
mjsor has quit []
julm_ has joined #ocaml
julm has quit [Nick collision from services.]
julm_ is now known as julm
julm_ has joined #ocaml
julm has quit [Nick collision from services.]
julm_ is now known as julm
tmaeda is now known as tmaedaZ
BiDOrD has quit [Remote closed the connection]
julm_ has joined #ocaml
julm has quit [Nick collision from services.]
julm_ is now known as julm
Camarade_Tux is now known as ClonedTux
run has quit [Read error: 110 (Connection timed out)]
_zack has quit ["Leaving."]
f_[x] has joined #ocaml
julm is now known as Camarade_Tux
Camarade_Tux is now known as julm
ClonedTux is now known as Camarade_Tux
yakov has joined #ocaml
<yakov> hey
<yakov> I have large ocaml code base and want to extend it in Haskell what can you suggest to mix these two langs?
<yakov> my knowledge of ocaml is limited to ability to write simple print-out for some ocaml data types in Haskell friendly format
<Camarade_Tux> separate programs?
<yakov> yes
<yakov> it would be easier I think if it will be separate program
<yakov> in fact, is there a standard way to print ocaml values? like Show class in Haskell?
<Camarade_Tux> otherwise you'd have two garbage-collectors in he same program :D
<yakov> I could not find such
<Camarade_Tux> yakov: no
<yakov> oh
<Camarade_Tux> extlib has a dump function but that's about it
<yakov> dump can handle any type, can it?
<Camarade_Tux> from Xavier Leroy: "This said, I agree with Basile that what you're trying to achieve (coexistence between several GCs) is risky, and that a design based on message passing and separated memory spaces would be more robust, if feasible.
<Camarade_Tux> "
<Camarade_Tux> I've not used it myself but I think it can
<yakov> well, the problem of separation seems to be simple. i work with well-known FFTW compiler and want to retarget it to different architecture and also tweak it to generate better code
<yakov> because of it's nature fftw already has several stages with dedicated data types representing intermediate values
<yakov> as for now I made silly patch to stop at needed stage and print out that intermediate representation to work with it later in my progam (in a pipe fashion)
<Camarade_Tux> doing it in ocaml is maybe a better solution
marteo has joined #ocaml
<Camarade_Tux> it'd be easier to ask for help, the changes could be merged back to fftw...
<Camarade_Tux> also fftw is quite old so it won't use lots of fancy features
<yakov> well, sure, but I don't know ocaml at such degree
<yakov> yes, it's plain ocaml
<yakov> learning ocaml will not bring anything new to me, also haskell has potention in making some aspects more clear, e.g. ad hoc monads as it is used in fftw at the presentvs Haskell do syntax etc
<Camarade_Tux> but on the other hand, spawning several processes, using IPC between them... may be bad for performance
<yakov> well, this is done once while preparing codelets for future use
<yakov> so we may sacrify performance here actualy
<Camarade_Tux> going through algsimp.ml, I onky see variants/enums, pattern-matching, anonymous functions, and >>=
<Camarade_Tux> nothing very difficult
<Camarade_Tux> (>>= is a self-defined operator)
<yakov> yes
<yakov> it's inside monad.ml iirc
<Camarade_Tux> I hadn't checked yet but I just noticed "open Monads.StateMonad" and "open Monads.MemoMonad" ;-)
Camarade_Tux has quit ["leaving"]
Camarade_Tux has joined #ocaml
aldebrn has joined #ocaml
<Camarade_Tux> bah, I'm stupid
<Camarade_Tux> I still think it'd be better to do that in ocaml because anyway you'd need to learn enough ocaml to do the IPC
<yakov> ipc is overkill here. simple text print out would do the job, so my program could be run in a pipe (genfft | myprog) with original slightly patched compiler
Yoric[DT] has joined #ocaml
<Camarade_Tux> has anyone played with Emily (as in "How Emily Tamed The Caml")?
<thelema> link?
<Camarade_Tux> (yakov, I still think the best/easiest/fastest way is to do it directly in ocaml)
<Camarade_Tux> hmm, brb
Yoric[DT] has quit [Remote closed the connection]
<julm> but.. in french
<Camarade_Tux> ;)
bzzbzz has quit ["leaving"]
BiDOrD has joined #ocaml
<thelema> I don't see any links to code.
hkBst has quit [Read error: 104 (Connection reset by peer)]
_andre has joined #ocaml
Alpounet has joined #ocaml
LeCamarade|Away has quit [Remote closed the connection]
<Camarade_Tux> that's one of the reason I'm asking if anyone has tried it ;)
<Camarade_Tux> http://erights.org/download/emily/ <- download
<Camarade_Tux> (read README.txt inside, and the zip file won't tarbomb ;) )
<thelema> E = emily?
<thelema> there's a bunch of .exe files.
<Camarade_Tux> yes and no, E is a programming language on its own but emily is related to it (emily is basically ocaml plus checks), they share the same goal with the same philosophy
<Camarade_Tux> yeah, .exe and .bat files, they used cygwin =/
<thelema> blah, all windows
<Camarade_Tux> yeah =/
Alpounet has quit [Ping timeout: 180 seconds]
* thelema tries ocamlbuild
<Camarade_Tux> good idea :p
<thelema> got it. emilyopt.byte compiles
<Camarade_Tux> got emilyopt.native here :p
<thelema> no --help, though
<Camarade_Tux> README.txt has some infos
<thelema> something to play with some other time. Full OCaml is great for me.
<Camarade_Tux> he ;)
<Camarade_Tux> I'm already lost in their requirements for compilation 0o00O_o
<thelema> three text files to configure different security parameters? ick.
<Camarade_Tux> for powerboxFolderPath, I'm already counting five text files and they provide some of them but they should have paths but they don't
<Camarade_Tux> (it'd be easier without any family member jabbering around)
LeCamarade has joined #ocaml
Narrenschiff has joined #ocaml
authentic has quit [Read error: 60 (Operation timed out)]
hkBst has joined #ocaml
_zack has joined #ocaml
blackdog_ has joined #ocaml
Narrenschiff has quit []
bombshelter13_ has joined #ocaml
authentic has joined #ocaml
willb has joined #ocaml
sgnb has quit [Read error: 104 (Connection reset by peer)]
sgnb has joined #ocaml
<Camarade_Tux> I didn't realize godi was years late wrt ledit (it has 1.16), ledit 1.17 has been available for almost two years and ledit 2.01 is available too
Amorphous has quit [Read error: 110 (Connection timed out)]
Amorphous has joined #ocaml
tmaedaZ has quit [Read error: 110 (Connection timed out)]
tmaeda has joined #ocaml
<kaustuv> thelema: if the argument is that for a reliable macro system you have to give up every other feature of the programming language, it's not very convincing. It is better to argue that meta-programming should be built-in (eg. meta-ocaml) in the language. However, I think macro systems engender a style of programming that is difficult to reason about and maintain.
gildor has quit ["leaving"]
<thelema> to have a reliable macro system, you have to have that system use the same parser as the language itself, which camlp4 gets right vs. every other macro system (except lisp)
yakov has quit ["Leaving"]
<kaustuv> Just parsing is not enough. His square() example illustrates it. He says one of its faults is that it only works for integers. The only way to fix this in the macro system is to let the macro know the type of the argument, and this is basically impossible in HM.
<thelema> it requires camlp4 to be part of the compiler enough to have the parse tree and some typing
<kaustuv> The only way to do type-indexed programming that has had any success is type classes, and they bring their own issues.
<thelema> or to have enough of the compiler built into it
<thelema> At least for the square() example, HM solves the problem, because the macro system doesn't need to know the types.
<thelema> and the compiler doesn't need to be told the types
<kaustuv> It doesn't because there isn't a polymorphic *
<kaustuv> In fact, because it does a type-case, it's an ad hoc polymorphic macro
<thelema> true.
<kaustuv> So that example is basically unconvincing to any Haskeller. His point about setf is stronger.
<thelema> hmm, would all this work with lisp if it were statically typed?
<thelema> if lisp were statically typed, wouldn't it be in the same boat as ocaml for square()?
<kaustuv> Depends on whether * itself is a macro. But at some low level there will have to be a type-case.
<kaustuv> Generally for Lisp and other languages with dynamic types that low level is inside the runtime.
<kaustuv> (I like my arithmetic ops not to involve branches, thankyouverymuch)
<thelema> JIT fixes that.
<det> overloading * is a solved problem (as kaustuv alluded to)
<det> Prelude> let square x = x * x
<det> Prelude> :type square
<det> square :: (Num a) => a -> a
<orbitz> unlikely ocaml will get typeclasses though, AFAIK
<kaustuv> I think we can do better than Haskell-style type classes. We basically know how (Dreyer-Harper-Rossberg style modular mixins). It's now basically a matter of some ML dialect implementing it.
<orbitz> I don't nkow what DHR is
<kaustuv> sorry, there are two related papers I'm referencing there, Modular Type-Classes and Modular Mixins.
<orbitz> how is it better than type classes?
<kaustuv> It's under the control of the user for one. No magical global instances. No problem with overlapping. No need for gymnastics involving multi-parameter classes with functional dependencies
<det> I've read about mixin modules and havent found them superior to type classes
<orbitz> I think I am too new to this stuff to really grok that
<det> The whole value of type classes IMO, is that it is implicit
<kaustuv> det: the "Modular Type Classes" paper says how to get canonical (=implicit) functor applications
<det> Ill check that out
<det> in Ocaml you can always do type classes explicitly, of course
<det> # let square (star: 'a -> 'a -> 'a) x = star x x;;
<det> val square : ('a -> 'a -> 'a) -> 'a -> 'a = <fun>
ched_ has joined #ocaml
<orbitz> det: how would i then use that for doing square with float or int?
<thelema> orbitz: square *. 3.
<thelema> orbitz: square * 12
Ched has quit [Read error: 145 (Connection timed out)]
julm has quit [Nick collision from services.]
ski_ has quit ["Lost terminal"]
<orbitz> ohh i see i was thinking star would be something equal to the name fo the typeclass
<orbitz> like 'num'
<thelema> it is - in this case, the typeclass is a single operation: star
<thelema> well, it isn't.
<thelema> you have to manually choose the right implementation
<thelema> If we had first class modules, we could pass a module as parametre
<orbitz> how do you get implicit typeclasses out of that?
<thelema> *explicit*
<orbitz> Right, so what changes do you have to make to get implicit?
<thelema> lots of magic, I think.
<orbitz> black magic?
<thelema> no, blue magic. Very ivory tower, intellectual, fluid, watery magic.
<orbitz> hot
<kaustuv> Blue magic is the ability to mimic the special moves of your opponents.
LeCamarade is now known as LeCamarade|Away\
LeCamarade|Away\ is now known as LeCamarade|Away
<thelema> has anyone run into a stack overflow in hashtbl.ml's resize function?
<tsuyoshi> thelema: I don't think it's possible.. I've had hash tables with billions of elements with no problems like that
* thelema is getting one.
<tsuyoshi> oh really
<thelema> yup, it takes about one minute
tmaeda is now known as tmaedaZ
tmaedaZ is now known as tmaeda
<thelema> and about 200MB memory
<thelema> Called from file "hashtbl.ml", line 58, characters 10-28
<thelema> I wish I could see the beginning of the stack trace, but it scrolls off my screen too fast
<thelema> and trying to 3&>2 it didn't seem to work
<orbitz> 3?
<thelema> stderr?
julm has joined #ocaml
<orbitz> 2
<orbitz> 2>&1
<orbitz> or are you on csh or soemthign?
<thelema> that would explain why it didn't work.
<thelema> bash
<orbitz> there you go
<Camarade_Tux> or &> for the lazy (redirects for stdout and stderr)
<thelema> I'll remember that last one - it's what I want most of the time.
<orbitz> thelema: i make use of 'tee' a lot too
* thelema likes tee, but doesn't use it much
<thelema> Fatal error: exception Stack_overflow
<thelema> Raised by primitive operation at file "hashtbl.ml", line 62, characters 20-29
<thelema> Called from file "hashtbl.ml", line 58, characters 10-28
<thelema> Called from file "hashtbl.ml", line 58, characters 10-28
<thelema> hashtbl.ml line 62 is still part of resize - it's the first call to insert_bucket
<Camarade_Tux> thelema: would it be possible you have lots of collisions or lots of things with the same id?
* thelema is trying to figure out where the error is raised - he uses a few hashtables
<thelema> but all of them should be pretty small - I don't think there's any N in my program > 10,000
<thelema> okay, I take that back - there are some N's in the 20-30K range
<Camarade_Tux> but even with that, it must be hard to trigger a stack overflow
* thelema is counting Hashtbl.adds to see how many he does
<Camarade_Tux> as far as I know the (default) limit is 150k recursive calls, 32bit or 64bit
<thelema> I have a tree made from rules, and I walk the leaves of the tree, associating each rule with the leaves it created.
<thelema> I guess some rules generate lots of leaves, but I don't have a measurement for that yet.
nickw has joined #ocaml
<thelema> hmm, it fails on inserting the 66_489th leaf
* thelema switches to a hashtbl of lists
<thelema> instead of using the hashtbl to store multiple bindings
<Camarade_Tux> reminds me of a bad bug I had two or three weeks ago: basically all queues hash to the same values :o
<thelema> ick.
<Camarade_Tux> (maybe not all but at least some)
<thelema> it's possible these trees are hashing poorly... but I'd be surprised
<Camarade_Tux> and by some, I mean, the empty one, the one with only a single element, the one with two elements...
<Camarade_Tux> Hashtbl.hash is waiting for you to check
<Camarade_Tux> (and mantis is waiting for me to report that I think)
<kaustuv> Hashing mutable structures is generally a Bad Idea (tm)
* thelema is hashing immutables
<thelema> my rules are the keys
<thelema> ah, you were talking to the guy hashing queues
<Camarade_Tux> kaustuv: yeah, if you change anything you're doomed (wasn't there a discussion about that less than a month ago?) but I wasn't changing anything
<Camarade_Tux> and hashing stacks doesn't show the same problem
<thelema> oops, I was counting the wrong thing. maybe I am inserting huge numbers of elements into a hashtbl
<kaustuv> Camarade_Tux: queues are implemented as circular lists, and I am not sure how hash behaves on them. Stacks are just plain lists.
<hcarty> OCaml is apparently getting a bit more sugar - { x } can now (CVS HEAD) be used in place of { x = x }
<thelema> yay!
* thelema has a lot of { x = x; y = y; z = z }
<kaustuv> in patterns or in constructors?
<hcarty> I wonder what is does for { Foo.x }. I'm guessing it doesn't work.
<hcarty> kaustuv: I'm not sure
<kaustuv> it's useful in patterns, but seems like a bad idea for patterns
<thelema> oops, it is on the 535_278th insertion that it stack overflows
<kaustuv> err, bad idea for data
<hcarty> And nevermind regarding { Foo.x }. Apparently that works as well.
BiDOrD has quit [Remote closed the connection]
<kaustuv> so max_int + 1 <> min_int? That's progrees!
<Camarade_Tux> hcarty: \o/ for { x }
<Camarade_Tux> kaustuv: I'll have a look at the sources
_JusSx_ has joined #ocaml
<Camarade_Tux> hmmm, if it's cyclic
det has quit [Read error: 110 (Connection timed out)]
_zack has quit ["Leaving."]
det has joined #ocaml
<hcarty> What use is a Thread.t? I'm new to threads in general, and OCaml threading in particular. Is there a reason to keep it around after creating a thread?
<hcarty> Related to this, I now have a reasonably toplevel-friendly lablgtk2 + Cairo + PLplot setup. Now I just need to make the packaging nicer.
julm has quit [Remote closed the connection]
<hcarty> And it uses Batteries, of course.
julm has joined #ocaml
<thelema> hcarty: iirc, you can do some sorts of job control using the Thread.t
<thelema> mostly Thread.join and Thread.kill
<flux> mostly Thread.join, because Thread.kill is evil or isn't implemented
<thelema> yes. waiting on threads
<flux> although I don't think there's any particular reason to join threads in ocaml, if you are already using Event-module for synchronization
<flux> (they don't need to be reaped like posix threads need to be)
<thelema> true.
<Camarade_Tux> doesn't kill just kill without giving the thread any chance of cleaning up?
<thelema> I'm sure the resources of that thread will be GCed if you kill it.
<thelema> I dunno about filehandles, though
<flux> I'm pretty sure they won't be :)
<Camarade_Tux> that's what I had in mind: writing to disk and friends
<flux> atleast if you're talking about resources like handles
<thelema> which is why thread.kill is evil
<flux> one important resource that doesn't get released is mutexes
bluestorm has joined #ocaml
onigiri has joined #ocaml
stan_ has joined #ocaml
tmaeda is now known as tmaedaZ
slash_ has joined #ocaml
<hcarty> thelema, flux: Thanks. I'm using the Event module to signal the end of the thread (send a message when a window closes), so I don't think I have a need for the returned Thread.t at this time.
<thelema> ok
<orbitz> anyone working on a good forkIO?
<orbitz> rather than threading?
ulfdoz has joined #ocaml
aldebrn has left #ocaml []
run has joined #ocaml
<Camarade_Tux> that one looks better
<Camarade_Tux> bah, wrong channel, sorry
lanaer has quit [Read error: 104 (Connection reset by peer)]
<thelema> okay, batteries + bytecode + profiling. It seems I can't use ocamlbuild (its manual just says bytecode compilation works in a way incompatible with it)
<thelema> I'm trying "ocamlfind ocamlcp -package aaa -thread -I _build fdd.ml -o fdd.byte", but I get a "reference to undefined global `Batteries'
<thelema> Error while linking fdd.cmo: Reference to undefined global `Batteries'
lanaer has joined #ocaml
<thelema> aha, the magical -linkpkg flag
<thelema> or not...
<thelema> or linking with [-o byte.cmo] is a bad idea
ski_ has joined #ocaml
ched_ has quit [Read error: 113 (No route to host)]
nickw has quit [Client Quit]
<thelema> hmm, 83% of my time is spent running compare_val
<thelema> maybe hashtables keyed on trees isn't such a good idea
<bluestorm> thelema: maybe you could cook up a more efficient hash function ?
<thelema> even if I do, it'll still have to check for equality when it does .find
<thelema> no?
BiDOrD has joined #ocaml
<bluestorm> you can also implement "equal" yourself, but i'm not sure it helps
* thelema needs to switch from = to ==
<thelema> when possible
_zack has joined #ocaml
* thelema goes back to imperative programming over arrays
quentin_ has joined #ocaml
<thelema> that helped - 40+ seconds of running compare_val dropped to 16 seconds.
<thelema> It's still 82% of the runtime, somehow...
julm has quit [Remote closed the connection]
julm has joined #ocaml
harlos has quit [Read error: 104 (Connection reset by peer)]
ulfdoz has quit [Read error: 110 (Connection timed out)]
Mr_Awesome has joined #ocaml
quentin_ has quit ["leaving"]
Snark has quit ["Ex-Chat"]
<hcarty> Any interest in a (very basic, alpha-level) Gtk_light module? It is a simplified wrapper around a bit of lablgtk2.
Alpounet has joined #ocaml
<hcarty> Right now, windows, (v|h)boxes, sliders and drawing areas.
marteo has quit [Read error: 110 (Connection timed out)]
<Camarade_Tux> I think rwmjone* made one but I'm not sure
marteo has joined #ocaml
<Camarade_Tux> hcarty: also, how did you do it?
<Camarade_Tux> and it could be very nice since lablgtk is not trivial to grasp and can be overkill for simple projects
<Camarade_Tux> hcarty: did you already mention that here? it feels like I already said that...
<hcarty> Camarade_Tux: I mentioned something about attempting it, and have talked about (but not followed up on) updating Chris King's FrGui
<hcarty> http://0ok.org/ocaml/gtk_light.tar.gz if you are interested
<Camarade_Tux> at least I'm not mad (yet) ;)
<hcarty> It requires Batteries and lablgtk2
<Camarade_Tux> should be ok :)
BiDOrD has quit []
<hcarty> Camarade_Tux: Not remembering conversations on #ocaml is why I am glad someone out there is silently logging this place...
<hcarty> The conversation here generally swaps between a trickle and a flood.
<hcarty> Camarade_Tux: ocamlbuild basic_gui_test.byte should build a very simple demo
<hcarty> Or .native if you prefer
willb has quit [Read error: 60 (Operation timed out)]
<Camarade_Tux> hcarty: was about to ask you how to compile ;)
<Camarade_Tux> hcarty: yeah, irc backlogs are very useful :)
<Camarade_Tux> hcarty: Error: Unbound value Gdk.GC.create in basic_gui_test.ml
run has quit [Client Quit]
<hcarty> Camarade_Tux: Hmmm... odd
<hcarty> You could comment out that section of the function - everything except the "true"
<hcarty> Nothing would be drawn in the window, but it should run then
<hcarty> I wonder if that is a more recent addition to lablgtk2. What version do you have?
<Camarade_Tux> reference to undefine flobal `GRange'
<Camarade_Tux> ;)
<hcarty> Wow
<hcarty> Everything is just falling apart :-)
<Camarade_Tux> must be the build
<Camarade_Tux> hcarty: you're using godi, right?
<hcarty> Camarade_Tux: Yes
<Camarade_Tux> you need to change _tags, it needs pkg_lablgtk2
<Camarade_Tux> oh, diagonal lines :)
<Alpounet> hcarty, what does gtk_light consist in ?
<Camarade_Tux> hcarty: but I don't have plot and plcairo, are they in godi?
<hcarty> Camarade_Tux: Ah, wonderful, thanks
<Camarade_Tux> :)
<hcarty> Camarade_Tux: No, they are part of PLplot. Not yet in GODI.
<Camarade_Tux> hcarty: ok, that's what I thought :)
<hcarty> Alpounet: It is a simple, very early/alpha, lablgtk2 wrapper.
<hcarty> Camarade_Tux: I hope to get it in GODI at some point, but that requires making GODI and cmake play nicely together.
<Alpounet> the kind of library we need for applications needing very basical GUI stuffs ?
<hcarty> Alpounet: Yes. And, potentially, not so basic. With the hope that it will be simpler to compose the GUI than when using lablgtk2 directly.
<Alpounet> ok
<Alpounet> I guess it is object-based, since based on lablgtk
ofaurax has joined #ocaml
<hcarty> Alpounet: The object stuff is hidden.
<Alpounet> fine :)
Ched has joined #ocaml
Ched has quit [Client Quit]
Ched has joined #ocaml
<Alpounet> that looks kinda fine
<Camarade_Tux> hcarty: you defined the 'hbox' function : 'a list -> unit or did it already exist in lablgtk?
<hcarty> Camarade_Tux: I defined it, though it's not far from what is in lablgtk2
<Alpounet> hcarty, please keep the DSEL approach, it's so practical !
<Camarade_Tux> hcarty: I'm always spending hours in the lablgtk documentation, I'll check that :)
<Camarade_Tux> "dsel"?
<Alpounet> Design Specific Embedded Language.
<hcarty> http://0ok.org/ocaml/gtk_light/gtk_light.ml (and .mli) to browse the code
<Alpounet> here, it'd mean to have a "subset" of OCaml to create the GUI parts of applications.
<Alpounet> Thanks to custom operators etc, we can achieve that, though it's a bit tricky.
<Alpounet> (to find a good "sub language")
<hcarty> The naming and general approach is taken more or less directly from Chris King's FrGui, minus the built-in "Fr"
<Alpounet> 'k.
<hcarty> Though I've been able to tie in the React library through callbacks.
<Camarade_Tux> Alpounet: ok, thanks :)
<hcarty> Alpounet: Thanks for the description :-)
<hcarty> http://0ok.org/ocaml/gtk_light/basic_gui_test.ml is a simple test, with a basic demo of what is going on.
<hcarty> Camarade_Tux: And I updated the .tar.gz to include the proper _tags content -- thanks!
<Alpounet> Camarade_Tux, typically, DSELs are often built with templates & operator overloading (C++), typeclasses, overloading & totally new operators (Haskell).
f_[x] has quit [Read error: 110 (Connection timed out)]
<Camarade_Tux> hcarty: :)
<Camarade_Tux> Alpounet: I see
<Alpounet> In other words, it lets the user write very short stuffs, which, behind, "generates" or at least execute much more code. It is powerful because from a user point of view, you don't have many things to care about.
<bluestorm> Alpounet: OCaml has camlp4 for that
<Alpounet> for example, ``button "foo" 250 250 no_callback |> label "bar" 100 35'' would create a button etc
<Camarade_Tux> as I said, I'm always spending hours in the doc when using lablgtk even though I'm fairly experience with it now =/
<bluestorm> (besides the obvious "convenient libraries" approach)
<Alpounet> bluestorm, yeah, when it becomes too heavy to get things like we want in pure OCaml, camlp4 is very handy.
BiDOrD has joined #ocaml
<bluestorm> actually
<Alpounet> a syntax extension providing a way to write GUIs in a short and efficient way would be great, and make GUIs more ... present, in the OCaml world :-)
<Alpounet> see how it's been handy with Macaque
<bluestorm> not all things can be done in "pure OCaml", and camlp4 extensions also need a "pure" library encoding the ocaml-exprimable part of your application domain
<Alpounet> bluestorm, yeah, the "semantic" part of the library.
<Alpounet> Syntax extensions would just represent a sort of "shortcut" to that.
<bluestorm> actually you sometimes have to encode a bit of the semantic in the camlp4 part
<bluestorm> when you're doing non-typable operations
<Alpounet> can you give an example ?
<bluestorm> hm
<bluestorm> the GROUP BY encoding in macaque
<Camarade_Tux> bluestorm: wanted to ask you, have you been able to try emily (who tamed the caml)?
<bluestorm> haven't, I only read the paper
<kaustuv> what is this emily?
<bluestorm> kaustuv: a capability-security-able subset of OCaml
<bluestorm> Alpounet: basically, you have separate fields for the "select" and the "group by" parts of the query
<bluestorm> but you want to return both parts to the user
<Alpounet> yeah
<bluestorm> so you need in essence the union of two object/records types
<bluestorm> wich isn't typable in "pure OCaml"
<Alpounet> I see, yes. You gotta make that part of the work in the syntax ext. right ?
<bluestorm> so the syntaxic abstraction has to do a bit of the semantic work (constructs value with the right post-union type)
<Alpounet> ook
_andre has quit ["leaving"]
<kaustuv> So emily is basically OCaml - Obj, Marshal, unsafe_*, etc.?
<bluestorm> kaustuv: it's a bit more elaborate than that
<Alpounet> is it a sort of haskellish ocaml ?
<bluestorm> "open_in" is not included either
<Alpounet> (for the purity part)
<bluestorm> Alpounet: nope, it's a subset of the language wich respect the object-capability approach
<Alpounet> oh ok
<bluestorm> and it's not pure, iirc they only forbid references to cross the module boundaries
<bluestorm> (as they could be used as covert channels)
_zack has quit ["Leaving."]
<kaustuv> no new exceptions?!
<Camarade_Tux> bluestorm: I tried emily a bit but didn't read the whole doc and couldn't figure everything (and lacked an example) and afaict it checks the source with emily(opt) and then it calls ocaml(opt) with some modules redefined but I'm not completely sure
<Camarade_Tux> kaustuv: yes, no new exception
<kaustuv> hah, this is an invalid Emily program:
<kaustuv> (* open_in *)
<kaustuv> as is:
<kaustuv> let foo () = "Obj.magic" ;;
<Camarade_Tux> he :p
<Camarade_Tux> would maybe be better as camlp*
<bluestorm> camlp4 wouldn't be enough : module Obj = struct let magic () = () in end let foo () = Obj.magic ()
<Camarade_Tux> right, and here it's probably better to create false positives than false negatives
<bluestorm> not exactly sure what you mean
<bluestorm> but I agree that, if the analysis is obviously incomplete, it better be simple at least
<Camarade_Tux> in this context, it's probably safer to wrongly flag programs as unsafe than miss some
<Camarade_Tux> and that too ;)
<bluestorm> but hm, I don't know how emilyopt works, but I supposed it was a bit more sophisticated than that
<bluestorm> kaustuv: are you sure this really is an invalid program ?
<kaustuv> bluestorm: I'm going by comments at the bottom of page 14
<kaustuv> I haven't actually run it
<Camarade_Tux> well, time to go to bed :)
<Camarade_Tux> good night
<bluestorm> kaustuv: I see
<bluestorm> they're actually mentioning Pervasives values only
<bluestorm> I suppose "Obj" is forbidden altogether
<kaustuv> well, it was just an example. Use "Array.unsafe_set" if you prefer
<mfp> thelema: Hashbtl doesn't store the hash value in the nodes, so it often calls the equal function more often than needed, and hashes the values repeatedly as it resizes the table
<mfp> (assuming you're not creating the hashtbls with the "proper" size from the beginning)
willb has joined #ocaml
<kaustuv> mfp: where in Hashtbl.resize is structural equality on keys used?
<mfp> kaustuv: not in resize, in find
<kaustuv> oh, I see, I misread your comment
<mfp> kaustuv: 2 separate issues (lookup & resize), both caused by the missing hash value in the nodes
bombshelter13_ has quit []
<kaustuv> There was a paper by Damien Doligez and Pascal Cuoq in the ML workshop last year (IIRC) that said exactly that hash values needed to be stored in the table
<mfp> heh
<mfp> I played with some finite map implementations some time ago > http://github.com/mfp/ocaml-finite-maps/tree/master
<mfp> Hashtbl_hval is Hashtbl with the hash values in the nodes (which thus become quite heavy)
<mfp> Fasthashtbl uses open addressing (double hashing) and lower load factors vs. Hashtbl* (since it takes less mem per element, so we can have more buckets for the same amount of mem)
sramsay has joined #ocaml
gildor has joined #ocaml
stan_ has quit [Client Quit]
hkBst has quit [Remote closed the connection]
BiDOrD has quit [Read error: 104 (Connection reset by peer)]
_JusSx_ has quit ["leaving"]
harlos has joined #ocaml
Lomono has joined #ocaml
harlos has quit ["leaving"]
Lomono has left #ocaml []
sramsay has quit [Remote closed the connection]
bluestorm has quit [Remote closed the connection]
smimou has quit ["bli"]
Associat0r has joined #ocaml
marteo has quit ["Debian GNU/Hurd is Good."]
kaustuv has quit [Remote closed the connection]