<nysin>
I want a polymorphic identity function factory (well, really I want something more complex but if I can't even get the type system to swallow this...) and I'm having trouble - see pastebin link for elaboration
<bluestorm>
the beta-expansion should not take place at definition location, but at use location
<bluestorm>
instead of
<bluestorm>
let foo = id_factory ();;
<bluestorm>
use
<bluestorm>
let foo x = id_factory () x;;
<bluestorm>
let id_factory () = id;;
<bluestorm>
let foo x = id_factory () x;;
<bluestorm>
works fine
<nysin>
it's been a while since I've done stuff with alpha/beta/eta expansions/reductions so I'll look that up too (don't remember it very well) but at least yes, this does work
<bluestorm>
hum
<bluestorm>
beta-expansion only means "add an parameter to each sides" here, nothing lambdious
<Axioplase>
bluestorm: that's "eta expansion", not "beta expansion"
<bluestorm>
hmm
<bluestorm>
you must be right
* bluestorm
apologies
<Axioplase>
:)
<bluestorm>
actually, i'm manipulating recursive datatypes and fold/unfold at the same time, doesn't really help my crap-saying symptoms
<nysin>
hm, this appears to be an application of the FAQ on eta expansion you linked, even
filp has quit ["Bye"]
<nysin>
Is there an intuition behind "results from application are weakly polymorph" though?
<nysin>
it seems separate, I'd think, from the ref stuff
<nysin>
(an aside, that answer needs a bit of native English editing...)
struk_atwork has joined #ocaml
<nysin>
"This conversion is only valid if bottom and \ x . bottom are equivalent in all contexts. They are certainly equivalent when applied to some argument - they both fail to terminate. If we are allowed to force the evaluation of an expression in any other way, e.g. using seq in Miranda or returning a function as the overall result of a program, then bottom and \ x . bottom will not be equivalent. " maybe
<nysin>
since the last part is true in O'Caml
<bluestorm>
hmm
<nysin>
or well returning blahblah
<bluestorm>
beware of the haskellish considerations
<nysin>
Yes I found that page on the Haskell wiki
<nysin>
they like point-free programming :p
<bluestorm>
in ocaml it's directly related to mutable data structures, and i'm not sure it is equivalent to the monomorphism restriction
<bluestorm>
even if the effects are actually the same
<bluestorm>
i mean
<bluestorm>
"bottom" is a lazy language consideration
<nysin>
O'Caml has delay & promise in some form I thought
<bluestorm>
yes but i think it's not that way
<bluestorm>
the link between "lazy things" on one hand and "mutable things" on the other hand
<nysin>
ah
<bluestorm>
may be that "lazy things" imply "thunks" that are (silently) mutated, then having some common points with "mutable things"
<bluestorm>
but this is pure guesswork, i haven't looked at that
<nysin>
It seems like O'Caml has that anyway too, in streams
<nysin>
so it would have a superset of Haskellish concerns
<nysin>
or a largely-overlapping set at least
<bluestorm>
anyway, there are two theoretic problem, wich i'm not sure are the same (the haskell downsides of removing the monomorphism restriction would be to re-evaluate more values iirc), but have the same consequences on the typing system
<bluestorm>
nysin: if the problem was only lazyness-related, you would only encouter it when using lazy values inside ocaml, ie. the "lazy" keyword and the Lazy module
<bluestorm>
wich is not the case
ygrek has quit [Remote closed the connection]
ygrek has joined #ocaml
seafood has quit []
jeremiah has quit [Read error: 104 (Connection reset by peer)]
Snrrrub has joined #ocaml
vbmithr has joined #ocaml
thelema has quit [Read error: 110 (Connection timed out)]
Linktim has joined #ocaml
OChameau has quit ["Leaving"]
jeremiah has joined #ocaml
Yoric[DT] has joined #ocaml
postalchris has joined #ocaml
drewism_ has joined #ocaml
drewism_ has quit [Client Quit]
Linktim_ has joined #ocaml
Linktim has quit [Read error: 110 (Connection timed out)]
ygrek has quit [Remote closed the connection]
ygrek has joined #ocaml
psnively has joined #ocaml
psnively has quit [Client Quit]
Yoric[DT] has quit ["Ex-Chat"]
nysin has quit ["Leaving"]
RobertFischer has joined #ocaml
lordmetroid_ has joined #ocaml
Yoric[DT] has joined #ocaml
LordMetroid has quit [Connection timed out]
<flux>
hmh, I'd really like to see a Map with many of Set's functions for keys: min_elt, max_elt, split, choose, ..
<Yoric[DT]>
hi
<Yoric[DT]>
Well, I guess I could write something such for Batteries => ExtLib.
<flux>
it seems so wasteful to have both Set and Map when they could conceivably be implemented with the same source (of Map). infact Set would then just be a special case of Map. well, almost
<flux>
that would be nice
<flux>
nice, map.ml is only 200 lines long
lordmetroid__ has joined #ocaml
<flux>
argh, it actually has function "min_binding" but it's not exposed :)
<flux>
one trick I've used with sets has been making a set of (a * b), and if I know the lower bound of b, I can just do Set.split (a, lower_bound) to find the association
<flux>
yoric[dt], would taking the map.ml from the standard library the be the base be ok license-wise?
<Yoric[DT]>
Normally, everything is LGPL+linking exception.
<flux>
and that's what the std lib is too?
<flux>
apparently yes
<flux>
I guess it should be a small task to implement that then
thelema has joined #ocaml
<Yoric[DT]>
If you want to write that, feel free, too :)
<flux>
;-)
lordmetroid__ has quit ["Leaving"]
Linktim_ has quit [Read error: 104 (Connection reset by peer)]
lordmetroid_ has quit [Connection timed out]
Linktim_ has joined #ocaml
ofaurax has joined #ocaml
Linktim_ has quit [Remote closed the connection]
Snark_ has quit ["Ex-Chat"]
<flux>
I'm done. Perhaps I should do some testing..
<flux>
uh, why would "choose" use "min_elt" instead of using the root.. I suppose they've wanted to give the guarantee that the order of 'choose' will be the same if the trees (logically) are
tty56_ has joined #ocaml
<flux>
I wonder if that guarantee is worth the log n ;)
<flux>
I would like to think the name 'choose' would just do that, choose an arbitrary element, and might not be repeatable if the tree was constructed in another fashion
<pango_>
I guess many algorithms that use 'choose' build the new set without the returned element, to handle all elements recursively...
Snrrrub has quit []
sporkmonger has quit []
<pango_>
removing the root each time may require more rebalancing?
<bluestorm>
wouldn't a fold be better to handle all the elements ?
<flux>
pango_, I think it might not
<flux>
bluestorm, well, if you sometimes need to stop the processing early
<bluestorm>
(the docs says that " equal elements will be chosen for equal sets.")
Axioplase has quit [Read error: 110 (Connection timed out)]
<pango_>
for what definition of equal anyway
<flux>
pango_, balancing is performed if the branches differ more than 2 in height
<flux>
I think for compare a b = 0
<bluestorm>
pango_: Set.S.Equal ?
<bluestorm>
.equal, sorry
<bluestorm>
« equal s1 s2 tests whether the sets s1 and s2 are equal, that is, contain equal elements. »
<bluestorm>
so this is logical equality
<pango_>
then flux analysis may be correct, they chose that algorithm to satisfy this condition
tty56 has quit [Read error: 110 (Connection timed out)]
<flux>
tested it out and gave a new glance to the modifications, it looks ok ;) (the set and map appear to use the same kind of code; boo, no code sharing! ;-))
r0bby has joined #ocaml
<flux>
I'm hoping the CVS version of map hasn't been much in the flux, I just happened to have one around from my last godi installation.. but I guess they've been quite stable, as most of the standard library has been.
sporkmonger has joined #ocaml
filp has joined #ocaml
<flux>
for extlib it's missing the exceptionless interface
<flux>
and perhaps the rest of the set functions could be added too
<flux>
atleast the ones that cannot be implemented efficiently without seecret access
<flux>
(it would be the union/subset functions)
delamarche has joined #ocaml
delamarche has quit []
Axioplase has joined #ocaml
det has quit [Read error: 104 (Connection reset by peer)]
det has joined #ocaml
<Yoric[DT]>
Okay, testsuite passed.
<Yoric[DT]>
That's a big yeaaah.
<Yoric[DT]>
(despite the fact that the testsuite is so small)
tty56_ has quit []
ygrek has quit [Remote closed the connection]
Ched- has quit [Remote closed the connection]
sporkmonger has quit [Read error: 110 (Connection timed out)]
jlouis has joined #ocaml
jdev has quit [Read error: 104 (Connection reset by peer)]
jdev has joined #ocaml
filp has quit ["Bye"]
<palomer>
erm
<palomer>
(1,(2,3)) has type (int*int*int)
<palomer>
how do I get a term of type (int*(int*int)) ?
<jlouis>
# (1, (2,3));;
<jlouis>
- : int * (int * int) = (1, (2, 3))
<jlouis>
huh?
<palomer>
my bad!
ofaurax has quit ["Leaving"]
bluestorm has quit ["Konversation terminated!"]
vpalle has joined #ocaml
RobertFischer has left #ocaml []
l_a_m has quit [Remote closed the connection]
sporkmonger has joined #ocaml
vpalle_ has joined #ocaml
hoelzro has joined #ocaml
<hoelzro>
hello, is there a setenv() function in Ocaml?
vpalle has quit [Read error: 110 (Connection timed out)]