<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
<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.
<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?
<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?
<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 ?
<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
<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>
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
<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)
<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)]