mbishop changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | Grab OCaml 3.10.2 from http://caml.inria.fr/ocaml/release.html (featuring new camlp4 and more!)
TychoBrahe has quit [Read error: 110 (Connection timed out)]
TychoBrahe has joined #ocaml
alexyk has quit []
rodge has joined #ocaml
Kopophex has quit [Read error: 110 (Connection timed out)]
|Catch22| has quit [Read error: 104 (Connection reset by peer)]
|Catch22| has joined #ocaml
alexyk has joined #ocaml
<Ramzi> thelema: are you there?
dlomsak has joined #ocaml
netx has quit ["Leaving"]
<alexyk> my experiment on a very huge set has shown that Hashtbl is much faster
<alexyk> so much for Set
<alexyk> the doc string should read, "Set: backward syntax, and unnecessary"
alexyk has quit []
alexyk has joined #ocaml
<orbitz> syntax? teh syntax for set is ocaml
<orbitz> i think your conclusions are perhaps a bit biased towards a specific goal
<jlouis> indeed they are
<jlouis> The case in point is that Sets implements operations not present in hash tables
<jlouis> or Hashtbl
<jlouis> to be specific
<orbitz> Set is also not mutable, which is useful in various situations
<orbitz> (personanly, i prefer pure functional containers in many cases)
RobertFischer has joined #ocaml
evn_ has joined #ocaml
alexyk has quit []
alexyk has joined #ocaml
alexyk has quit [Client Quit]
RobertFischer has quit []
Ramzi has quit ["http://irc.netsplit.de/"]
alexyk has joined #ocaml
alexyk has quit []
dlomsak has left #ocaml []
alexyk_ has joined #ocaml
<hcarty> Does pa_float (http://brion.inria.fr/gallium/index.php/Pa_float) work for anyone here?
<hcarty> Using the code on that page, compiled using the command listed on that page, gives errors: http://ocaml.pastewith.us/67
evn_ has left #ocaml []
alexyk_ has quit []
alexyk has joined #ocaml
alexyk has quit [Client Quit]
RobertFischer has joined #ocaml
RobertFischer has quit [Client Quit]
shortcircuit has joined #ocaml
rodge has quit ["Leaving"]
evn_ has joined #ocaml
alexyk has joined #ocaml
<flux> heh, searching for info on opengl/ocaml, found this" "Objective Caml OC is a doom-like 3D engine for PCs by François Pessaux. .. The source to Objective Caml will be online in the future."
<flux> (1997)
<orbitz> haha
alexyk has quit []
<flux> say, anyone doesn't happen to have code that does partially transparent textures with lablgl?
<flux> (with sdl too)
<flux> ah, finally
<flux> had forgotten Gl.enable `blend
alexyk has joined #ocaml
evn_ has quit []
Snark_ has joined #ocaml
bluestorm has joined #ocaml
vbmithr has joined #ocaml
vbmithr_ has joined #ocaml
vbmithr_ has quit ["leaving"]
filp has joined #ocaml
|Catch22| has quit ["To the best of my knowledge, I guess that I'm fresh"]
hkBst has joined #ocaml
middayc has joined #ocaml
yziquel has quit [SendQ exceeded]
yziquel has joined #ocaml
filp has quit ["Bye"]
bluestorm has quit [Read error: 104 (Connection reset by peer)]
bluestorm has joined #ocaml
schme has quit [Read error: 104 (Connection reset by peer)]
vbmithr has quit [Read error: 104 (Connection reset by peer)]
alexyk_ has joined #ocaml
alexyk__ has joined #ocaml
alexyk has quit [Read error: 110 (Connection timed out)]
schme has joined #ocaml
alexyk_ has quit [Read error: 110 (Connection timed out)]
alexyk__ has quit []
l_a_m has joined #ocaml
alexyk has joined #ocaml
alexyk has quit []
alexyk has joined #ocaml
alexyk has quit [Client Quit]
middayc_ has joined #ocaml
vfdfdfvd has joined #ocaml
middayc has quit [Read error: 110 (Connection timed out)]
LordMetroid has joined #ocaml
ikaros has joined #ocaml
<ulfdoz> I'm searching for some plugin-like mechanism, so that I'm able to load stuff at runtime. Scenario: I'm writing at a tool for managing and interpreting sieve-scripts. As sieve is spec'd for extensibility, I'd like to load non-standard functionality at runtime.
<tsuyoshi> you can load bytecode modules during runtime.. native loading is in current cvs
<ulfdoz> hmkay, inspecting.
munga has joined #ocaml
<bluestorm> in case you're interested, here is my draft of "OSR camlp4 extensions packaging"
<bluestorm> i'm leaving now, but i shall submit it to the mailing-list this afternoon
<bluestorm> (since yesterday, i've added two extensions of mine, that depends on type-conv)
<bluestorm> comments suggestions about the extensions choice and/or the overall structure are welcome
<bluestorm> (in particular, i'm very new to findlib/META packaging)
bluestorm is now known as bluestorm_aw
coucou747 has joined #ocaml
schme has quit [Remote closed the connection]
filp has joined #ocaml
schme has joined #ocaml
filp has quit [Remote closed the connection]
schme has quit ["bfirc dans ta gueule."]
<thelema> l
bluestorm_aw is now known as bluestorm
<thelema> bluestorm: any ideas how to integrate osr_camlp4 into the ocaml source tree?
<bluestorm> hm
<bluestorm> i don't care about integration *in* the ocaml source tree
<bluestorm> separate distribution is fine as far as i'm concerned
<bluestorm> but hm
<bluestorm> thelema: the extensions i've included so far could go in the camlp4/ subpart, for example a camlp4/Camlp4SyntaxExtension directory
<bluestorm> however, the OSR will eventually integrate full libraries with syntaxic support, and this is quite different
<thelema> camlp4/stdext ?
<bluestorm> hm
<bluestorm> the camlp4 directory naming conventions are more like Camlp4Parsers and Camlp4Filters so far
<bluestorm> but why not
<thelema> what do you mean by OSR? What's the scope of your recommendation?
<bluestorm> hmm
<bluestorm> actually i use OSR as a "name for a community-distributed ocaml bundle"
<thelema> camlp4/Camlp4Ext
<thelema> "Ocaml Standards Recommendation", no?
<thelema> It's nice and short, though.
<thelema> camlp4/Camlp4StdExt
<thelema> bah, the second camlp4 is just too redundant for me. camlp4/stdext
<bluestorm> :p
<bluestorm> have you seen the camlp4/Camlp4Parsers/Camlp4OcamlRevisedQuotationExpander.ml file ? :p
<thelema> Nicolas likes long names in CamelCase. Maybe he's an ex-java-guy.
<bluestorm> thelema: hm
<thelema> I guess we're lucky it's not more like camlp4/Camlp4Parsers/Camlp4ParsersOcamlRevisedQuotationExpander.ml
<thelema> with complete redundancy from one level to the next.
<bluestorm> i think you should wait a bit before DCVS-integration, as there are still some legal issues with one of the included extensions
<thelema> Sometimes I do wish that ocaml allowed folders as module namespaces.
<bluestorm> (there was no copyright or license specification on the file)
<thelema> bluestorm: good thing you tell me this - I was about to check it in to github.
<bluestorm> thelema: you can do that through -pack and ocamlbuild
<bluestorm> you could still include the others, but i don't think it's necessary yet : it still in an alpha stage, and we should at least wait for the mailing list reactions before doing anything serious
<thelema> by using -pack and ocamlbuild, I can have a subdir of my project and access modules in it through Subdir.Modulename?
vbmithr has joined #ocaml
* thelema considers VC very *not* serious.
<bluestorm> hm
<bluestorm> you're lucky Theo de Raadt isn't around
<bluestorm> :-'
<Smerdyakov> What is "VC" here?
<thelema> I'm happy living in the git paradigm of "commit hella often"
<thelema> VC = version control
<thelema> "When in doubt, commit. When not in doubt, commit"
<Smerdyakov> Why is VC very not serious?
<bluestorm> because it's easy to make changes, i guess
<thelema> I have a very low barrier of entry to VC - anything and everything relevant gets checked in.
<thelema> Of course some branches need more stringent requirements than others, but better to put something into VC than to leave it out.
* thelema compromises and only checks it into local VC, not uploading it to github.
<bluestorm> (the legal issue is with pa_oo btw)
<thelema> well, since it's jacque's code, I expect little trouble. He's a great guy - very accomodating.
<bluestorm> of course
<flux> hm, that polymap extension by the same guy looks interesting
<flux> too bad part of it is run time magic
<bluestorm> flux: i didn't include it because it needs runtime library support, but i guess we'll eventually have it distributed
<flux> so no sml records this time :)
<bluestorm> and btw
<bluestorm> the run time side is quite ugly :D
<bluestorm> the run time module looks innocent, but have a look at how the syntax extension use it : Obj.magic fest
<flux> of course it has all been proved with coq.. right? right?? ;-)
det has joined #ocaml
vbmithr has quit ["Z"]
fuzzdk has joined #ocaml
jlouis has quit ["brb"]
RobertFischer has joined #ocaml
jlouis has joined #ocaml
* RobertFischer is trying to figure out omake.
<flux> I keep on using my Makefile (and often OCamlMakefile) :-)
<bluestorm> haha thelema
<RobertFischer> I'm not very happy with the venerable make. I've been kinda taken with rake, but I wanted to give OMake a shot before wandering off to write a rake/ocaml bridge.
<RobertFischer> (I've got enough work on my plate. P)
<bluestorm> how should i interpret (\ _1 (\ _2 ) ) ?
<bluestorm> my current try gives me let test _1 _2 = _1 (fun _1 _2 -> _2)
<bluestorm> wich is logical if i apply the "higher hole number inside (\ ..)" rule
<flux> (\ _2 ) could be an error, no?
<bluestorm> should it not be let test _1 = _1 (fun _1 _2 -> _2) ?
<flux> I would think that the numbers would always refer to the innermost (\ )
<bluestorm> flux: hm, (\ _2 ) alone is quite clear, it's "the function that ignores the first parameter"
<bluestorm> flux: so (\ 1 (\2 )) would be (fun _1 -> (fun _1 _2 -> _2)) ?
<flux> bluestorm, but it's not symmetric; you can't write a function that ignores the third parameter?
<bluestorm> (instead of (fun _1 _2 -> (fun _1 _2 -> _2)) as it is now
<bluestorm> flux: (\ ignore _4; _1 _2) :-'
<flux> :)
<bluestorm> however, this function use 4 parameters (and ignore the third)
<flux> I would like an approach where the reader of the code doesn't need to know the ins and outs of syntax extensions
<bluestorm> (\ _1 ) . (\ _2) would work
<flux> so basically whenever you need to ask "what should this mean?", in my opinion it should not compile
<bluestorm> hmm
<bluestorm> so you would disable nested (\ ... ) ?
<flux> well, it would be very unlikely I would miss it!
<flux> (although imo nested (\) is more understandable than missing numbers)
<flux> and the difference between (\ _1) and (\ _9) being 8 arguments to apply seems quite strange, for such a small change :)
<flux> there is not much code "out there" that makes use of (\), yes
<bluestorm> isn't "uncurry (\ 2)" a nice way to say "snd" ? :-'
<flux> "yet" :-)
<bluestorm> err, _2
<flux> I would prefer "snd" :)
<flux> and how would fst then look like?
<flux> or thrd?
<bluestorm> "uncurry (\ ignore _2; _1 )"
<bluestorm> hm
<bluestorm> it would make sense to use \1 \2 \3 instead of _1 _2 _3, wouldn't it ?
<flux> hm, perhaps
<flux> simpler to write in US keyboard atleast ;)
<thelema> bluestorm: yes, \n seems reasonable - they seem pretty equivalent to backreferences
<thelema> flux: don't nest (\ .. )
<flux> thelema, I wouldn't :)
<bluestorm> it seems quite difficult to disable (\ ... ) nesting in a sane way
<flux> I suppose fully disabling isn't very pretty either
<flux> because if you move code around that happens to have an embedded (\ .. ) it breaks
<bluestorm> i suppose a sane convention would be a lambda-calculus-substitution like
<flux> I would expect (\..) to have only simple expressions within
<bluestorm> when computing the highest \n number in the expression, inner (\ ... ) are ignored
<hcarty> http://ocaml.pastewith.us/68 -- I am taking a very naive stab at generalizing the pa_float extension. How would I get the "Float" module name automatically, without hard-coding it?
<hcarty> The idea being to, eventually, have this work for Float.(...) or Matrix.(...) or ...
<bluestorm> hcarty: is that not a Summer of Code project ? :p
<hcarty> It is!
lordmetroid_ has joined #ocaml
<flux> one real-world cases I've used (\ ) for: let string_of_values = (\String.concat " " (List.map string_of_value _));
<hcarty> But I want to play with it now ... and the SoC project looks much deeper
<bluestorm> flux: a haskeller would say you lack good composition combinators
<bluestorm> List.map string_of_value >| String.concat " "
<flux> I suppose that's true
<flux> but why go through the trouble of combinators when you have pa_hole?-)
<bluestorm> :p
<bluestorm> (the haskeller would then babble about point-free programming)
* RobertFischer would then beat up the Haskeller.
<hcarty> Nevermind, it was a simple change... m = UIDENT in place of "Float"
<hcarty> "My OCaml programmer beat up your Haskell programmer"
<Smerdyakov> One reason that discourages point-free OCaml programmers is the fact that OCaml never optimizes through closures.
<Smerdyakov> This isn't a problem with SML and MLton.
<Smerdyakov> s/programmers/programming
<thelema> flux: your string_of_values code already is part of OSR - String.of_list f l
LordMetroid has quit [Connection timed out]
ikaros has quit [Read error: 104 (Connection reset by peer)]
RobertFischer has left #ocaml []
lordmetroid__ has joined #ocaml
pango_ has joined #ocaml
<bluestorm> hehe
<bluestorm> my current try translates (\ foo ) into foo
<bluestorm> flux: would that disturb you ?
<bluestorm> (if there is no \n inside (\ .. ) it doens't change anything )
ikaros has joined #ocaml
<flux> bluestorm, I suppose that would be expected
<bluestorm> fine
<flux> even though fun () -> foo could be more useful ;-). but now I would be in conflict with my own opinion ;)
lordmetroid_ has quit [Connection timed out]
<bluestorm> fun () -> ... or fun _ -> ... ? :p
pango has quit [Remote closed the connection]
l_a_m has quit [Remote closed the connection]
<flux> I believe fun () -> .. is the standard choice for a function that takes no arguments?
lordmetroid__ has quit [Read error: 104 (Connection reset by peer)]
<flux> it could be useful with, say, Thread module: Thread.create (\print_newline "bar") ()
<jlouis> Smerdyakov, "Optimizes through closures?" could you elaborate on what that means in your book?
lordmetroid__ has joined #ocaml
<flux> or many other modules that take an action function in
<Smerdyakov> jlouis, whenever code would build a closure in the naive compilation, it will build a closure in the optimized compilation, too.
<flux> of course, that could be written as Thread.create print_newline "bar", and for other arities Threacd.create (f a) b, but sometimes you end up having a (fun () -> ..) ()
<flux> say, Thread.create (\try a with exn -> report_death (Thread.id ()) exn) ()
<jlouis> Smerdyakov, thanks.
Jedai has quit [Read error: 110 (Connection timed out)]
Jedai has joined #ocaml
<jlouis> I ponder ... will ocaml always build a closure on, say, List.map f foo or can it defunctionalize it to a variant List.map' (f, foo)?
<Smerdyakov> I think it always builds a closure.
<Smerdyakov> Well, no, I thought you meant something else.
<Smerdyakov> Curried arguments are handled properly.
<Smerdyakov> Passing an anonymous function to [List.map] always builds a closure.
<jlouis> I see
<orbitz> any wached this: http://youtube.com/watch?v=faJ8N0giqzw
<orbitz> it's kind of neat
<bluestorm> so this is a google talk named "tangible functional programming"
<bluestorm> could you sum up the neat part ?
<bluestorm> (i'm lazy and this is 56:23 long)
lordmetroid_ has joined #ocaml
munga has quit ["Ex-Chat"]
<orbitz> bluestorm: basicaly he wants to make it so a GUi rerpesents a function
<orbitz> then youcan compose guies
<orbitz> so like pipes, but less suck
<orbitz> jump to 39:40
<bluestorm> thanks
<bluestorm> i completely disabled _ : do you think it is a problem somehow ?
<orbitz> the idea seems pretty neat. I don't know ho well it'd work for applications in general (although i'd like to see it) but for somethign like GIMP it'd probably be great
delamarche has joined #ocaml
lordmetroid__ has quit [Success]
<thelema> bluestorm: I agree with flux - it might be nice to have (\ foo ) ==> [fun () -> foo], but it makes total sense for a function without any holes to be not a function.
<bluestorm> "() is the empty hole" might be a not-too-hairy interpretation
<thelema> also, is ( \ foo ) allowed? (whitespace between ( and \)
<thelema> I assumed a single token '(\'
lordmetroid__ has joined #ocaml
vfdfdfvd has quit [Read error: 110 (Connection timed out)]
<bluestorm> thelema: ( \ foo) is allowed
<bluestorm> afaik, a single token (\ would ask for changes at the lexer level (it's possible but i'm lazy)
<bluestorm> thelema: and (\1) is interpreted as (\ 1 ), that is ( 1 )
<bluestorm> orbitz: you're right, this is quite funny
<bluestorm> i'll show it to a friend of mine that is interested in graphic visualization
<Smerdyakov> You guys should read the ICFP programs, so that you don't take so long to notice these things. ;)
<orbitz> :)
<orbitz> what do you think of the video Smerdyakov ?
<Smerdyakov> I haven't watched it. I say the talk at ICFP.
<Smerdyakov> s/say/saw
<orbitz> do you have an opinion on the idea?
<Smerdyakov> Good idea.
<orbitz> from what i saw, one thing he seems to lack is the ability to look back at what you are composing
<orbitz> once youc ompose something you get a new value, which makes sense, but makes debugging difficult
lordmetroid_ has quit [Connection timed out]
<fuzzdk> Hi. I have made a small function:
<fuzzdk> let rec myfun x endvalue = match(x) with
<fuzzdk> x when x=endvalue -> endvalue
<fuzzdk> | x -> myfun (x+1) endvalue
<fuzzdk> ;;
<fuzzdk> I wonder if it can be written in a nice way - without a when condition
<fuzzdk> I have tried:
<fuzzdk> let rec myfun2 x endvalue = match(x) with
<fuzzdk> endvalue -> endvalue
<fuzzdk> | x -> myfun (x+1) endvalue
<fuzzdk> ;;
<bluestorm> that won't work
<fuzzdk> Which is of course not good
<bluestorm> you could use if .. then .. else instead of pattern matching
<bluestorm> this should be more appropriate in this case
lordmetroid__ has quit [Read error: 104 (Connection reset by peer)]
<Smerdyakov> fuzzdk, also, it's bad style to put the expression you're [match]ing in parentheses.
<fuzzdk> I would like to pattern match - in my real function I have more than one parrameter - and it would make the function more easy to read
<bluestorm> could you show the real function ?
<fuzzdk> Smerdyakov: thanks, I will try to stop that
lordmetroid__ has joined #ocaml
<fuzzdk> Well, it is not completely done yet, but currently it look like:
<fuzzdk> let rec find_end_point direction endvalue (bmp :rgb24) x y color = match (x) with
<fuzzdk> x when x=endvalue -> endvalue
<fuzzdk> | x when color = bmp#get x y -> find_end_point direction endvalue bmp (x+direction) y color
<fuzzdk> | x -> x
<fuzzdk> ;;
<orbitz> pastebins are your friend
<fuzzdk> But I would like to pattern match on both x and color
<bluestorm> it looks like if/then/else is still a good way to do
<Smerdyakov> In fact, I see 0 value from using pattern matching there.
<Smerdyakov> If the cases you haven't added yet will actually use pattern matching well, then make a [match] expression your final [else] case.
<fuzzdk> Well, there is no value if I can't match to a value of a parameter
<Smerdyakov> fuzzdk, I don't know what that means.
<fuzzdk> I mean if I can't write it without the "when" then it doesn't make the code easier to read than if I write it with if,then,else
lordmetroid__ has quit [Client Quit]
<bluestorm> you're right, pattern matching can only match with pattern, not values
<bluestorm> so you shouldn't use pattern matching here
<bluestorm> and if / then / else is quite readable actually
<bluestorm> if x = endvalue then endavlue
<bluestorm> else if color = ... then ...
<bluestorm> else ...
<orbitz> what if i want a 'case' like semanics?
<bluestorm> orbitz: you create a syntax extension ?
<orbitz> match seems to facilitate that well enough though?
<Smerdyakov> fuzzdk, you don't agree that this is better? http://adam.chlipala.net/tmp/test.ml
<bluestorm> i'm thinking of two more pattern-related keywords : linear and value
<bluestorm> hm
<bluestorm> "value" is not that good, "const" may be better
<bluestorm> match (a, b) with const foo -> ... | linear (x, x) -> ...
bluestorm has quit [Remote closed the connection]
<orbitz> guess his ISp didn't much like that
<fuzzdk> <Smerdyakov>: It seems at first much more complicated. The good thing is that you don't have to remember the order of the parameters for the patternmatch. I think I would prefere a patternmatch if it was possible without the when
<orbitz> why is the when bad?
<Smerdyakov> fuzzdk, interesting. Can you find anyone else who doesn't think that your original version is much more complicated?
<Smerdyakov> fuzzdk, (This just goes against my intuitions about complexity.)
<fuzzdk> Oh, I don't think my original version wasn't more complicated - it has the when
<Smerdyakov> fuzzdk, yeah, pattern matching can only be used to test equality with constants. It's not a panacea.
Linktim has joined #ocaml
<fuzzdk> orbitz: I think the when is bad, because it is not a simple table anymore when you use the when
<orbitz> i think think match is meant to bea simple table
<Smerdyakov> The [when] version is bad because it's obviously more complicated than the [if] version I linked.
<Smerdyakov> It uses pattern matching frivolously, incurring no benefit.
<orbitz> well in teh grand scheme of things, i think the 'when' is not the problem, it's the match in general
<Smerdyakov> I agree that [when] clauses are fine when used with [match]es that actually do pattern matching.
<fuzzdk> With the "const" keyword by bluestorm, I think it would be good to have pattern match here?
<fuzzdk> Then it would look like this I think: http://ocaml.pastebin.com/d37c03eb7
Linktim has quit [Read error: 110 (Connection timed out)]
smimou has quit ["bli"]
bluestorm has joined #ocaml
smimou has joined #ocaml
<hcarty> bluestorm: http://ocaml.pastewith.us/71 -- A working but very simple-minded version of a general pa_float extension
<hcarty> Not something that will compete with the OSP project, but a working hack of an existing camlp4 extension at least
<bluestorm> and iirc it's much more beautiful than the original martin jambon's implementatoin
l_a_m has joined #ocaml
smimou has quit ["bli"]
<hcarty> It is based on the http://brion.inria.fr/gallium/index.php/Pa_float - I had to make the changes at the bottom of the page to get that original version to compile and function for me
<bluestorm> hcarty: i was thinking of the original implementation, http://martin.jambon.free.fr/extend-ocaml-syntax.html#replacing
<bluestorm> wich (as you can see) is quite ugly :p
<bluestorm> Ast.map/fold are a real win in those cases
<hcarty> Ah yes... I would have been much more reluctant to try this if that was my starting point.
smimou has joined #ocaml
Yoric[DT] has joined #ocaml
<bluestorm> hey Yoric[DT]
<bluestorm> this is no ready for distribution yet, but it is a base layout
<Yoric[DT]> hi
* Yoric[DT] will take a look off-line.
<bluestorm> :p
<thelema> hi Yoric[DT]
<Yoric[DT]> hi
Jedai has quit ["KVIrc 3.2.4 Anomalies http://www.kvirc.net/"]
<bluestorm> Yoric[DT]: btw, i've extracted your pa_for extension from comprehensions
<Yoric[DT]> Good idea.
<bluestorm> the other parts needs library support, i've been looking at pure extensions only (and type-conv modules) for now
<bluestorm> (is it ok for the extensions to depend on type-conv ?)
Jedai has joined #ocaml
<Yoric[DT]> In my mind, it's ok.
<Yoric[DT]> I'm very much planning to make it a standard module, anyway.
<Yoric[DT]> bluestorm: I don't remember who opened that page (I don't think it's you, at least :))
<bluestorm> i haven't written anything on the wiki/mailing-list yet, but i'll do that eventually :p
<bluestorm> sepxlib requires library support, so i won't include it right now, but i may include pa_monad soon (i didn't at first because i had not seen the 3.10 port)
<Yoric[DT]> btw, bluestorm, do you have your Number.t stuff online somewhere ?
sporkmonger has joined #ocaml
<Yoric[DT]> Thanks.
<Yoric[DT]> Mind if I add it ?
<sporkmonger> is there a way to do an "eval" in ocaml?
<bluestorm> of course not
<Yoric[DT]> sporkmonger: yes, but it's a ugly hack, plus it's very much not recommended
<sporkmonger> how ugly?
<Yoric[DT]> Running the compiler from your application.
<Yoric[DT]> That ugly :)
<sporkmonger> lol, ok
<Yoric[DT]> If you're looking for that, chances are that there's a better way to handle stuff.
<sporkmonger> looking to implement a DSL of sorts
<sporkmonger> and not quite prepared to go down the ocamlyacc road
<bluestorm> camlp4 might help you
<sporkmonger> what's that?
* Yoric[DT] incr bluestorm.
<Yoric[DT]> Anyway, gottago.
<Yoric[DT]> Cheers.
<bluestorm> bye
<bluestorm> sporkmonger: it's a preprocessor
<sporkmonger> "incr bluestorm"?
<Yoric[DT]> I'm adding one point to bluestorm :)
<sporkmonger> is that like "what he said"?
<bluestorm> must means he agrees with my wise words :-'
Yoric[DT] has quit ["Ex-Chat"]
<sporkmonger> ha, ok
<bluestorm> he more or less defines a DSL for lambda expressions
<sporkmonger> ok
<bluestorm> (the readable file is the second, lambda_test.ml)
<bluestorm> (don't be afraid with the strange camlp4 code, you eventually get used to it)
<sporkmonger> well
<sporkmonger> that's probably what i want, you're right
<sporkmonger> but wow that example is hard to follow :-P
<sporkmonger> someone tried to explain the lambda calculus to me once
<bluestorm> the idea is more or less that you can define a custom parser, and use that syntax inside << ... >>
<sporkmonger> my brain started to leak out of my ears
<bluestorm> the parser being more or less a recursive descent one with some facilities
<bluestorm> so this can be used to implement DSL
<sporkmonger> yeah
<sporkmonger> that sounds like what i want
<bluestorm> on the other hand, one can use those tools on OCaml syntax itself, and thus create syntax extensions
<bluestorm> camlp4 also provides AST transformation tools (mapping, folding)
<sporkmonger> i've got a client that's working on a port of an old AI system from C to OCaml, and they've got this awful imperative pseudo-language they wrote to interact with it
<sporkmonger> don't really want to port that thing as-is
<bluestorm> unfortunately, camlp4 documentation is sparse and quite harsh
<bluestorm> but it's constantly improving :-'
<sporkmonger> stuff like this makes me crazy:
<bluestorm> you could write a parser for that and get it translated into a nice algebraic data type
<hcarty> bluestorm: Is (\ \1 +. x) equivalent to (fun v -> v +. x) when using pa_holes?
<bluestorm> it is
<sporkmonger> yeah, anything along those lines would be an improvement
<hcarty> bluestorm: Ok, thanks
<bluestorm> actually, \1 can be placed anyplace an identifier can
<bluestorm> wich is slightly more powerful than an usual function
<bluestorm> hmm
<bluestorm> isn't :-'
<bluestorm> (\ \1.field ) is correct too
<bluestorm> (\ record.\1 ) would be parsed but fail at compilation
<hcarty> Very cool
r0bby has quit [Connection timed out]
alexyk has joined #ocaml
alexyk_ has joined #ocaml
alexyk has quit [Read error: 104 (Connection reset by peer)]
<hcarty> bluestorm: How would I write 'm = UIDENT; "."; "("; e = SELF; ")"' in an <:expr< $uid:mm$.($expr:e$) >> like way in an Ast.map class?
<hcarty> I am not sure if that is the right way to ask that question...
<hcarty> But I want to be able to nest Module.( ... ) constructs. Something like: Matrix.( m1 + m2 +: Float.(1 + 2) )
<bluestorm> hm
<bluestorm> what i don't understand is : can't you nest them with the current code ?
<hcarty> If I do, the inner Float.( ... ) contents would use Matrix.add rather than Float.add (or +. in this case)
<bluestorm> that's strange
<bluestorm> are you sure ?
<hcarty> That's what camlp4o prints
<hcarty> Matrix.( mat1 + mat2 *: Float.(1 + 1) ) --> Matrix.add mat1 (Matrix.mul_scalar mat2 (Matrix.add_float 1. 1.))
<hcarty> With a few additional operators in the extension - ( *: ) matches to Foo.mul_scalar
<bluestorm> camlp4o pa_test.cmo -str "Matrix.( mat1 + mat2 *: Float.(1 + 1) )"
<bluestorm> Matrix.add mat1 (mat2 *: (1. +. 1.))
<hcarty> Huh. Maybe I changed something else without realizing it.
<bluestorm> (i used http://ocaml.pastewith.us/71 )
<palomer> is there a tutorial on using generalized algebraic datatypes with ocaml?
<hcarty> bluestorm: Ah, I figured it out... I had <:expr< ( +. ) >> -> <:expr< $uid:m$.add_float >>
<bluestorm> :p
alexyk_ has quit []
bzzbzz has quit ["leaving"]
thelema has quit [Read error: 110 (Connection timed out)]
alexyk has joined #ocaml
evn_ has joined #ocaml
middayc_ has quit []
middayc has joined #ocaml
ofaurax has joined #ocaml
<hcarty> bluestorm: Thanks for your help, and your extensions - now I can obfuscate my code, add another point of failure with respect to syntax changes and breaking loading my code in the toplevel :-)
<hcarty> With the side effect of making the code more concise and easier to follow in many places
<bluestorm> :p
<bluestorm> you can use "topfind" to easily enable syntax extensions in the toplevel
<hcarty> I was thinking of the #use bug when camlp4 extensions are loaded
<bluestorm> hm
<bluestorm> wasn't it corrected by 3.10.1 ?
<hcarty> Does not seem to be, either in 3.10.1 or 3.11 CVS
<hcarty> Two #use toplevel commands give "I/O error: Bad file descriptor" when camlp4 is in use
<bluestorm> btw, you could try to send your work to the SoC guy
<bluestorm> right, i still have that bug
<hcarty> I think I will - even if they use a different method, I would like to keep the two consisten so I can swap theirs in when/if it is all finished
delamarche has quit []
<bluestorm> hcarty: do you know a reason the bug wasn't corrected yet ?
ofaurax has quit ["reboot à cause de la pile bluetooth qui a pété un irq...."]
<hcarty> bluestorm: I do not. http://caml.inria.fr/mantis/view.php?id=4495 -- It is marked acknowledged but has not changed since
<hcarty> I am hoping that it will be fixed before 3.11, but I wouldn't know where to start to provide a bug fix
<hcarty> It was around in 3.09.x as well I think
<bluestorm> so this is not camlp4>=3.10 specific ? strange :p
<hcarty> I can't be certain as I don't have access to camlp4 < 3.10. But I am fairly certain I had the problem with 3.09.x. I just assumed it was my fault since I was very new to OCaml at that point.
<bluestorm> :p
<bluestorm> "OCaml : you can feel innocent when you see a segfault"
<hcarty> I was wrong - it does not seem to happen with 3.09.2, at least not with a very minimal OCaml install on Etch
l_a_m has quit [Remote closed the connection]
<palomer> is it possible to turn off the ocaml type system?
<hcarty> I emailed the student and metor for the Delimited Overloading project and updated the Camlp4 wiki with my changes to the pa_float code
<hcarty> palomer: I don't think so. You can use dark magic (Obj.magic) to do tricky things, though it is generally considered a very bad idea. Why do you want to?
<palomer> I'm compiling into ocaml
<palomer> and the typesystem of the object language is slightly more general than what ocaml can handle
<palomer> hrmph
<palomer> how do I find the GADT section of the ocaml manual?
<bluestorm> there are no GADT in OCaml
<palomer> eh...
<palomer> really??
<palomer> bummer
<palomer> wait
<palomer> I can just bypass the type system completely
<palomer> how do I use obj.magic?
<mattam> Obj.magic === unsafeCoerce I think
<hcarty> bluestorm: Drat, a problem with the new pa_float : Float.( 1 + x.(0) ) --> (1. +. x.(0.))
<palomer> mattam, how do I use it?
<bluestorm> hcarty: :p
<hcarty> palomer: The general rule thrown around is that if you have to ask, you shouldn't use it
<bluestorm> hcarty: you could allow x.(Int.(0))
<bluestorm> in the specific array-get case you can have a nicer solution
<bluestorm> but more generally you'll need a disabling mechanism
<mattam> Obj.magic : 'a -> 'b. I think that's pretty obvious. It is dangerous though, as you have to be certain that the runtime representations you're coercing are the same.
<bluestorm> and Int.(...) seems quite nice for that
<palomer> mattam, righto
<bluestorm> hcarty: did you disable transformations inside nested Foo.( ... ) ?
<palomer> obj.magic is _exactly_ what I need!
<bluestorm> i think it would be saner on the long term
<hcarty> bluestorm: No, I did not. Though to be honest I don't know how :-)
<bluestorm> hmm
<hcarty> <:expr< Int.($e$) >> -> <:expr< $e$ >> -- the simple minded match approach does not work, which I suppose should be obvious I guess because the transform seems to be recursive
<hcarty> s/I guess/it seems/
<hcarty> Ack, that is an awkward sentence
<bluestorm> | <:expr< $array$.($index$) >> -> <:expr< $self#expr array$.($index$) >>
<bluestorm> this is the array-access-specific patch
<bluestorm> (you have to change "object" into "object (self)" )
jlouis has quit ["Leaving"]
<bluestorm> actually, disabling the nested transform is not easy, and i'm thinking of ugly hacks :-'
<bluestorm> hehe, i may have a simple ugly hack in mind
<hcarty> bluestorm: Hacks are welcome - the array patch does its job from what I can tell
<bluestorm> it works :]
<bluestorm> the output is slightly cluttered, but you could purify it with a Filter
<bluestorm> (a hack to correct the hack side effects)
<bluestorm> the idea is basically to "sign" the transformed part with a specific AST part, in this case ((); foo)
<bluestorm> heh
<bluestorm> | <:expr< ( (); $pass$ ) >> -> pass is even better
<hcarty> Is it possible to match something like '( or `( rather than using ( (); ... ?
<bluestorm> '( and ` are not legal expressions, so i don't think it would
<hcarty> That's what I thought
<bluestorm> however, it could be possible to use something illegal in code, but legal in the ast, like $lid:"UGLY HACK"$
<bluestorm> but then you would really require a filter to get rid of that after transformation
jlouis has joined #ocaml
<bluestorm> i think ((); ...) is quite simpler and may even have good side effect
<bluestorm> you *could* say to your user "if for some reason you need to disable transformation, use (); ..."
<bluestorm> hcarty: on another topic, i think it would be better on the long run to delete the Float-specific part, and to attach a runtime Float module that would provide the needed functionality
<bluestorm> (or maybe they have very different behavior, wich i'm not sure is desirable)
<hcarty> I think a Float module would be the way to go - my only concern would be speed. I don't know if it slows things down at all to use Float.add rather than (+.)...
<bluestorm> there may be performances problem in specific case (some operations are specialized by the compiler if the type is known at compile-time), but you should investigate before doing anything unnecessarily nasty
<bluestorm> moreover, a defunctorizer would provide a generic solution to that problem, and we might have one again in the future
<hcarty> Yes, I am not sure how much time I should put in to this given the similar OSP. It is something of an interesting learning experience though.
<hcarty> And if it ends up being useful for someone else the so much the better
Mr_Awesome has joined #ocaml
Snark_ has quit ["Ex-Chat"]
fuzzdk has quit [Read error: 104 (Connection reset by peer)]
fuzzdk has joined #ocaml
rodge has joined #ocaml
alexyk has quit []
ofaurax has joined #ocaml
<TychoBrahe> noz vat
testonetg has joined #ocaml
|Catch22| has joined #ocaml
alexyk has joined #ocaml
testonetg has left #ocaml []
fuzzdk has quit [Read error: 110 (Connection timed out)]
rodge has quit [Remote closed the connection]
ofaurax has quit ["plouf"]
LordMetroid has joined #ocaml
Jedai has quit [Read error: 104 (Connection reset by peer)]
Jedai has joined #ocaml
<hcarty> bluestorm: What do the parts of "Ast.TyDcl _loc n tpl tk cl" mean from pa_private.ml? Or do you have a pointer to where I could find this my self?
<bluestorm> hm
<bluestorm> hcarty: you know that <:foo< bar >> expressions expand to camlp4 AST terms ?
<bluestorm> Ast.TyDcl is one of those terms, that has no quotation equivalent afaik, so we use it as-is in the code
<hcarty> Ok
<bluestorm> _loc is the location
<bluestorm> hm
<bluestorm> TyDcl means "type declaration"
<bluestorm> TyDcl of Loc.t and string and list ctyp and ctyp and list (ctyp * ctyp)
<hcarty> I am trying to make a pa_private which does a transform similar to that discussed here: http://caml.inria.fr/pub/ml-archives/caml-list/2007/11/548712fc1b14955da573783c4d942c54.en.html
<bluestorm> n is the type name, tpl is the "type parameter list" (type ('a, 'b, ...) foo = ...), tk the type content (type foo = ...), and cl the constraint list (type foo = bar constraint ... = ... and ... = ... and ...)
<bluestorm> hcarty: you can try in your command line
<bluestorm> camlp4oof -str "<:str_item< type ('a, 'b) foo = bar constraint 'a = int and b = string >>"
<bluestorm> (TyDcl is not accessible as a quotation, but the str_item that contains a type declaration is)
<bluestorm> the output is quite verbose :p
<hcarty> Wow, yes it is
alexyk has quit []
<bluestorm> err
nuncanada has joined #ocaml
<bluestorm> actually it's not "and b = string" but "constraint 'b = string"
<bluestorm> hcarty: camlp4 is a good way to learn about ocaml features you never used :-'
r0bby has joined #ocaml
<hcarty> http://ocaml.pastewith.us/74 -- This is takes "private type t = int" and expands it in to an included module + signature. I'm trying to work through how to generate the name "t_of_int" to make a generating function.
<hcarty> The commented parts being non-functional toying around
ikaros has quit ["segfault"]
middayc_ has joined #ocaml
seafood_ has joined #ocaml
Snrrrub has joined #ocaml
middayc has quit [Read error: 110 (Connection timed out)]
seafood_ has quit []
seafood_ has joined #ocaml
hkBst has quit ["Konversation terminated!"]
delamarche has joined #ocaml
middayc_ has quit []
evn_ has left #ocaml []