<love-pingoo>
jonasb: yeah, that's the normal thing to do
<love-pingoo>
writing mli is annoying, duplicating a lot of the ml sometimes
<love-pingoo>
ocamlc -i -c bla.ml can be useful to generate the mli for you
<jonasb>
love-pingoo: cool, thanks
<jonasb>
I now ran into another problem... I create a bar record in foo.ml and call a function in another module, which expects a Foo.bar, but those two types clash
<jonasb>
I guess I'll have to create another module which contain the shared types
Chrononaut has left #ocaml []
<love-pingoo>
jonasb: it's ok to declare the type in foo.ml, and use it in the other module (not redeclaring it), but the usually surprising thing about that is that if you don't "open Foo" in the other module you have to prefix the field names with foo
<love-pingoo>
if it's unclear, you can paste something
slash_ has quit ["leaving"]
<jonasb>
the problems seems to be that the two types (in foo.ml and foo.mli) weren't considered as the same type by the compiler
<jonasb>
but moving the type declatations to another module solved it all, so I'm good for now
Amorphous has quit [Read error: 104 (Connection reset by peer)]
oriba has quit ["Verlassend"]
nuncanada has quit ["Leaving"]
Amorphous has joined #ocaml
jonasb has quit ["leaving"]
bohanlon has quit [Read error: 104 (Connection reset by peer)]
tonyIII__ has quit [Read error: 60 (Operation timed out)]
tonyIII__ has joined #ocaml
bohanlon has joined #ocaml
realtime has joined #ocaml
bohanlon has quit [Read error: 110 (Connection timed out)]
bohanlon has joined #ocaml
ulfdoz has quit [Read error: 60 (Operation timed out)]
ulfdoz has joined #ocaml
tripwyre_ has quit [Read error: 60 (Operation timed out)]
sporkmonger has quit []
love-pingoo has quit ["Connection reset by pear"]
ttamttam has joined #ocaml
schme has quit ["leaving"]
schme has joined #ocaml
tonyIII__ has quit [Read error: 60 (Operation timed out)]
tonyIII__ has joined #ocaml
ygrek has joined #ocaml
_zack has joined #ocaml
vuln has quit ["leaving"]
ttamttam has left #ocaml []
ched has joined #ocaml
<oleg|log>
hi, does using camlp4 for defining a completely different grammar make any sense?
jlouis has quit [Read error: 104 (Connection reset by peer)]
simplex has joined #ocaml
simplex has quit [Read error: 104 (Connection reset by peer)]
_zack has quit ["Leaving."]
bluestorm has joined #ocaml
ched has quit [Remote closed the connection]
appletizer has joined #ocaml
Asmadeus has quit [Connection reset by peer]
Asmadeus has joined #ocaml
ikaros has joined #ocaml
appletizer has left #ocaml []
Yoric[DT] has joined #ocaml
seafood has quit []
<Yoric[DT]>
hcarty: sorry, I didn't have time to test your package yesterday.
<Yoric[DT]>
hcarty: testing now
jlouis has joined #ocaml
<mfp>
is there anything in the works for shell-scripting-like stuff in Batteries? (running & piping commands, etc.) I can't see anything besides Shell in the API docs
<mfp>
and the Unix.*_process functions operating on input and _ output, which is a good start
<Yoric[DT]>
mfp: ocamlnet's will probably end up included
<Yoric[DT]>
(or something similar)
|jeremiah has joined #ocaml
|jeremiah has quit [Read error: 104 (Connection reset by peer)]
ttamttam has joined #ocaml
<Yoric[DT]>
hcarty: installation works.
ttamttam1 has joined #ocaml
ttamttam has quit [Read error: 104 (Connection reset by peer)]
ttamttam1 has quit [Client Quit]
ttamttam has joined #ocaml
|jeremiah has joined #ocaml
hkBst has joined #ocaml
ttamttam has quit [Read error: 113 (No route to host)]
|jeremiah has quit [Read error: 104 (Connection reset by peer)]
ttamttam has joined #ocaml
Smerdyakov has joined #ocaml
|jeremiah has joined #ocaml
|jeremiah has quit [Read error: 104 (Connection reset by peer)]
<thelema>
Yoric[DT]: would it be reasonable to have a module type 'Comprehensible', with a bit of checking by the compiler that various modules are actually comprehensible?
|jeremiah has joined #ocaml
jonasb has joined #ocaml
<bluestorm>
thelema: it's planned
<Yoric[DT]>
thelema: I believe bluestorm has planned to do this.
<bluestorm>
:]
<Yoric[DT]>
Oh, well :)
<bluestorm>
but it's a bit more subtle than that
<bluestorm>
i'm not sure a single interface will do the job
<bluestorm>
eg. String.map : (char -> char) -> t -> t is accepted, and is not polymorphic
<thelema>
ah, hmmm...
<ski__>
what might `comprehensible' mean in this context ?
<bluestorm>
ski__: it's "you can use the pa_comprehension syntax extension with"
<thelema>
ski__: works with our syntax extension for list comprehensions
<Yoric[DT]>
bluestorm: we have the same problem with Enumerable, btw
<bluestorm>
Yoric[DT]: i've thought of different solutions
<Yoric[DT]>
(i.e. [String] is not exactly [Enumerable])
<bluestorm>
perhaps we could do something like
<bluestorm>
type 'a enumerable = String.t with 'a = char
<bluestorm>
or have an MonoEnumerable interface
<Yoric[DT]>
/with/constraint/
* ski__
is not familiar with `pa_comprension'
<Yoric[DT]>
But yeah, this may be possible.
<Yoric[DT]>
ski__: in OCaml Batteries Included, we have list/string/map/whatever/ comprehension.
<ski__>
it is somewhat similar to monad comprehensions ?
<ski__>
providing libraries considered useful, out-of-the-box ?
<bluestorm>
ski__: yes
<bluestorm>
and possibly some syntax extensions
<bluestorm>
and a consistent documentation
<bluestorm>
actually it's a bit more than "useful libraries", there is an idea of generality / coherence wich would improve over the current stdlib state
<bluestorm>
(eg. there is a more generic container datatype used in most places, a higher-level IO layer, etc.)
* ski__
wonders why `where' is left-associative
<bluestorm>
is there not a rationale somewhere ?
<ski__>
Associativity
<ski__>
a where b where c is equivalent to (a where b) where c
<ski__>
is all i see on it
<bluestorm>
"it is more natural to have an aligned indentation"
<bluestorm>
(it's in the source file, not in the documentation, sorry)
<bluestorm>
ski__: why would you want right-associativity ?
<ski__>
consider
<ski__>
...
<ski__>
where
<ski__>
foo x = ...
<ski__>
where
<ski__>
bar y = ..x..y..
<ski__>
baz z = ...
<ski__>
(possibly with a `where' clause for `baz' as well)
<ski__>
i presume you also want `d' in scope of `c', et.c. there, yes ?
<ski__>
so, the other way to write that would be to introduce a reverse-sequential declaration combination, i suppose
<bluestorm>
hm
<bluestorm>
you can use the d-binding inside the c-expression, yes
* ski__
hasn't given this sort of problem much thought in languages which doesn't have mutually-recursive-per-default declaration groups
<ski__>
(.. ok, no parallel comprehension clauses, i see)
kaustuv has joined #ocaml
<bluestorm>
ski__: i dislike Haskell recursive-per-default behavior and I think that's one of the main problems of the Haskell (otherwise quite light and enjoyable) syntax
<ski__>
that's an understandable position for a strict language
<ski__>
(and, yes, there's also other arguments there)
<bluestorm>
well
<bluestorm>
it's sometimes really nice to be able to use say "let x = wrap x"
Cheshire has joined #ocaml
* ski__
agrees
<Smerdyakov>
Non-termination is a bitch to reason about, and so it's nice to know that you couldn't possibly have introduced it.
<thelema>
bluestorm: there's no shortge of variable names - don't code like there is.
<flux>
thelema, however sometimes inadavertently using an old binding can introduce bugs
kg4qxk`` has quit [Client Quit]
<Smerdyakov>
thelema, so if I build a value step-by-step, with a let-binding for each step, you think it's important to use a different variable name for each?
<thelema>
agreed. and I don't like typing long variable names, but that doesn't mean they're not right to use in some cases.
<ski__>
thelema : there's often a shortage of *meaningful* variable names
<thelema>
Smerdyakov: why a different let binding for each step? compose the functions.
<Smerdyakov>
thelema, let x = 1 in let x = x + 1 in let x = x + 1 in ....
<thelema>
ski__: no more than there's a shortage of musical notes that sound good together or meaningful sentences to write books with.
<thelema>
let one = 1 in let two = one + 1 in let three = two + 1 in ...
<kaustuv>
Explicit shadowing is a good hint to the compiler about the life of a variable. We don't need to pretend that ocaml is SSA
<Smerdyakov>
thelema, to me, that complicates the program.
<ski__>
thelema : now say i want to insert `let x = x * x in' somewhere in the middle of Smerdyakov's example, what new name should i use ?
<thelema>
if you're going to use the value only once like this, chain it in the function. If you're going to use it elsewhere, let bind it to a useful name.
<thelema>
ski__: depends on where you put it.
<ski__>
thelema : do you suggest renaming all the names after (alternatively before) the point of insersion ?
<ski__>
(s/s/t/)
<ski__>
doing so would be highly error-prone
<thelema>
if their meaning has changed, then yes.
<thelema>
doing such an insert without checking where the final value gets used would be error-prone
<ski__>
their meaning to me might be "the current state, after performing the previous mentioned operations"
<thelema>
better to have the compiler inform you where it's used, and have you make sure it's still a proper usage before changing it.
<thelema>
in such a static set of operations, if there's no meaning, collapse to: let x = 1
<thelema>
+ 1
<thelema>
+ 1
<thelema>
in
<bluestorm>
thelema: it's simply not realistic
<bluestorm>
the most common use case is the poor-man state monad
<bluestorm>
let (res, input) = parse_char "(" input in
<bluestorm>
let (res', input) = parse_expr input input
<bluestorm>
let (_, input) = parse_char ")" input in
<bluestorm>
...
<bluestorm>
(sorry for the first "res", it's useless)
* thelema
has done programming with res' type stuff. I hope I've outgrown that.
<bluestorm>
well consider (_, input) and (res, input) and (_, input)
<bluestorm>
i don't care, the point if the "input" part anyway
<bluestorm>
-if+is
<thelema>
(_, inside_paren) and (res, after_expr) and (_, after_close)
<thelema>
poor man's mutable variable...
<thelema>
and I start thinking of all the ways mutability causes problems
<ski__>
hence "poor-man state monad"
<ski__>
(state can help solve problems, where the state is warranted .. the trouble is not having control on which parts of the program may depend on / effect which state)
|jeremiah has quit [Read error: 104 (Connection reset by peer)]
Alpounet has quit [Read error: 104 (Connection reset by peer)]
Alpounet has joined #ocaml
|jeremiah has joined #ocaml
kg4qxk has joined #ocaml
jlouis has quit ["Lost terminal"]
jlouis has joined #ocaml
bzzbzz has joined #ocaml
<bluestorm>
oho, pa_comprehension bug.
pango has quit [Remote closed the connection]
sporkmonger has joined #ocaml
<hcarty>
Yoric[DT]: Thanks for testing
<hcarty>
Unfortunately, the section of the GODI manual related to conf-* packages seems to be unwritten
ttamttam has left #ocaml []
<Yoric[DT]>
hcarty: Why do you mirror the .tgz, though?
<Yoric[DT]>
Why not using the official .tgz?
<kaustuv>
Is there a reason why the implementation of 'a LazyList.t is exposed, esp. when LazyList.get exposes an equivalent view? To make sexplib happy?
<Yoric[DT]>
The initial idea was to allow a pattern-matching extension.
<Yoric[DT]>
(which used to exist and will return some day)
<hcarty>
Yoric[DT]: There is no official .tgz. To my knowledge, not official release was ever made
<hcarty>
Just CVS availability
<hcarty>
And I'm not sure if that is even maintained
<Yoric[DT]>
Ah, ok.
<hcarty>
What I will/should do is make my changes in to a patch against the source as provided by Fedora (what I used as a base)
<hcarty>
The Fedora source is, from what I can tell, a clean CVS checkout
<kaustuv>
Yoric[DT]: so you are committed to this implementation of 'a node_t then? Have you considered two cons constructors, one lazy and the other eager, which makes things like of_list considerably more efficient (no lazy thunks)?
<Yoric[DT]>
kaustuv: no, no strong commitment.
<Yoric[DT]>
hcarty: good idea.
<Yoric[DT]>
kaustuv: we used this implementation as it was slightly more regular
* ski__
idly wonders whether functions defined with `lazy' are properly tail recursive
<ski__>
(or rather s/are/can be/)
<kaustuv>
Yoric[DT]: Then why not use Lazy.lazy_from_val instead of lazy() in LazyList.of_list, etc.?
<Yoric[DT]>
kaustuv: no good reason.
* Yoric[DT]
is willing to change this.
<Yoric[DT]>
(actually, I kind of assumed that the compiler would do it for me)
<kaustuv>
It doesn't. lazy() is always a suspension.
<Yoric[DT]>
Always?
<Yoric[DT]>
Ok, good to know.
<ski__>
(.. i.e. whether forcing things like `filter (fun x -> x < 0) (upFrom 0)' would consume unbounded memory)
<Yoric[DT]>
ski__: well, only one way to know :)
<kaustuv>
ski__: filter is tail recursive while the predicate fails, so that would just loop forever. Even if it wasn't so, it wouldn't consume unbounded memory because you'd have a stack overflow long before that.
<ski__>
kaustuv : obviously stack overflow (for every finite stack size) would prove it consumed unbounded memory
<ski__>
(in the sense i meant, here)
* ski__
grudgingly gets off his lazy ass and fires up the interactor
<Smerdyakov>
OCaml is one of those shitty implementations that lets you run out of stack space when there's a lot of memory left.
<kaustuv>
That's because it uses the actual C stack instead of doing it all in the heap like MLton.
* Yoric[DT]
welcomes our local Smerdyakov to the conversation :)
<ski__>
.. hm, my `Lazy' not providing an (unit -> 'a t) -> 'a t operation looks suspicious
<ski__>
kaustuv : you wouldn't happen to have a nice link to the implementation of that `filter' ?
<kaustuv>
If batteries has a browsable repository, look in src/core/extlib/lazyList.ml line 388
<oleg|log>
what would be a sensible approach to doing a dynamic C binding in ocaml?
<oleg|log>
that is, I would like to call a C function in a dynamic link library by its name with its type signature being runtime data
<oleg|log>
i did a quick experiment in C where I used dlopen() and friends and a lookup table for pregenerated specific type callers, but that didn't look motivating to repeat in ocaml
<flux>
I think that could be an interesting way to build bindings for libraries
<flux>
iirc there was a related idea around, with some level of implementation, which allowed embedding c-code inside ocaml code
<flux>
can't find it now, though :/
<Yoric[DT]>
kaustuv: ok, for LazyList.of_list, there's actually a reason.
<Yoric[DT]>
That's because lists can be infinite in OCaml.
<Yoric[DT]>
And it would be weird to allow regular lists to be infinite but not to freeze during conversion from an infinite regular list into a lazy list.
<Yoric[DT]>
Now, I guess that we could easily check whether a list is infinite.
<kaustuv>
By infinite list, do you mean a recursive value such as: let rec ones = 1 :: ones;;
<Yoric[DT]>
Yep.
<flux>
are there any other kind of infinite lists?
<flux>
because, I mean, that's a (imho useless) corner case of lists..
<oleg|log>
flux: oh, such a link would be nice to have
<kaustuv>
Well, then you should fix eager_of_list, I suppose. Though I think supporting recursive values/cyclic structures via lazy lists is a bad idea in general
<Yoric[DT]>
Fixing this right now.
<Yoric[DT]>
Well, I agree that it's the wrong way to implement recursive values.
<hcarty>
oleg|log: I haven't used it, but it seems very promising
<hcarty>
At least for functions with simple interfaces
<oleg|log>
hm, although it does somehow the opposite job from what I want -- I want to run foreign C code loaded from a library, not inline it in my program
<ski__>
Yoric[DT] : what's the difference between `eager_append' and `append' ?
<hcarty>
oleg|log: There are some interesting examples in the ciml darcs repo
<Yoric[DT]>
ski__: er.... the first one should have been eager but isn't?
<hcarty>
Though they still require some inline C to properly wrap the functions
<Yoric[DT]>
(fixed, btw)
<kaustuv>
Yoric[DT]: I think the problem is that append is eager, not that eager_append is lazy.
<Yoric[DT]>
Afaict, [append] is lazy.
<ski__>
yes and no
<kaustuv>
ah, right you are
<kaustuv>
well, the two functions are exactly the same module alpha-equivalence, so one has to be wrong
<Yoric[DT]>
Yeah, [eager_append] is wrong.
|jeremiah has quit [Read error: 104 (Connection reset by peer)]
<ski__>
Yoric[DT] : `seq',`unfold',`map',`mapi',`eager_append',`rev_append' (at least .. not checked past `{6 Conversions}' yet) all potentially appear to be unduly strict
<Yoric[DT]>
[eager_append]: just fixed.
<Yoric[DT]>
Others: checking.
<Yoric[DT]>
(note that this code was written about 1 year ago and left mostly untouched since then)
<Yoric[DT]>
How is [seq] strict?
<ski__>
the problem is that arguably `map (fun x -> x + 1) s' should not yield an exception in the case the computing of the initial cons in `s' yields an exception .. *unless* and *until* the mapped stream is actually inspected
<Yoric[DT]>
Wait a second, let's start with [seq].
<Yoric[DT]>
What's wrong with [seq]?
<ski__>
this applies to every element, of course, not just the first one
* ski__
rechecks what `seq' was doing
<Yoric[DT]>
You mean that the condition should only be evaluated at a later stage, is that it?
<ski__>
Yoric[DT] : `seq data next cond' will call `cond data' before the output stream is being forced
<ski__>
yes
<Yoric[DT]>
ok
<Yoric[DT]>
Fixing.
<ski__>
also, as i said, this is arguable
<ski__>
but, to me, this seems like the right behaviour, in general
<Yoric[DT]>
Fair enough.
<Yoric[DT]>
[unfold] fixed, too
<ski__>
it's the same issue in the other i mentioned (and possibly in later ones i haven't checked yet, too)
<Yoric[DT]>
[from_loop], too, as a side effect
<ski__>
namely that either some function argument is called, or that an input stream is forced, before the lazy output (here a stream) is demanded
<kaustuv>
[append] is just wrong. It currently exposes l1 too early. It should be:
<kaustuv>
let rec append l1 l2 = lazy begin
<kaustuv>
match next l1 with
<kaustuv>
| Cons (x, t) -> Cons (x, append t l2)
<kaustuv>
| Nil -> Lazy.force l2
<ski__>
(yes, i didn't mention `from_loop' since it was just calling `unfold' so will do whatever that does)
<kaustuv>
end ;;
<ski__>
yes, almost
<ski__>
in this case it is acceptable
<ski__>
but in the `filter' case (which i haven't checked yet), a similar fix will probably not be as acceptable
<ski__>
(btw, obviously the above argument about exceptions can be replaced with computing expensive code too eagerly .. or doing I/O operations too eagerly .. et.c.)
<kaustuv>
filter will have to have an eager gobble for the false case of the predicate, but otherwise the outer lazy() is needed.
<Yoric[DT]>
[map], [mapi] fixed
<ski__>
yes, and this "eager gobble" will probably make the above proper tail recursion test fail
<ski__>
i'll give you a link where you can read about the issues, and one solution to it
<kaustuv>
is this Wadler's "without even being odd" paper?
<ski__>
no
* Yoric[DT]
finds this weird that [l2] needs to be forced.
<ski__>
specifically, check the discussion about the `lazy' vs. `delay' primitives there
* Yoric[DT]
will take a look.
<ski__>
in terms of O'Caml functions (not special syntax), those would have type signatures
<ski__>
delay : (unit -> 'a) -> 'a t
<ski__>
lazy : (unit -> 'a t) -> 'a t
<ski__>
where `lazy' is the needed primitive for lazy suspensions
<ski__>
(`t' here is, btw, not `LazyList.t' but `Lazy.t')
<Yoric[DT]>
And what's [t] ?
<Yoric[DT]>
ok
<Yoric[DT]>
Mmmhhhh....
<Yoric[DT]>
So you would need to combine [lazy] and [delay] to obtain OCaml's [lazy], is that it?
<ski__>
(however, one would probably need to expose something similar to `lazy' for `LazyList' if one wants to have compositionality, without exposing the representation)
<ski__>
O'Caml's `lazy' would (as a function) be the above `delay'
<Yoric[DT]>
Pushed a new version of lazyList.ml, if you're interested.
<Yoric[DT]>
So what is Scheme's [lazy], then?
<ski__>
a new primitive
<Yoric[DT]>
(thanks for the code reviews, then)
<Yoric[DT]>
Yes, but what is the point?
<ski__>
expression : a
<ski__>
------------------------------
<ski__>
(delay expression) : Promise a
<ski__>
expression : Promise a
<ski__>
------------------------------
<ski__>
(lazy expression) : Promise a
<ski__>
the point is that, in e.g.
<Yoric[DT]>
(besides the fact that I have a [delayed] in [Enum] which looks much like Scheme's [lazy])
<Yoric[DT]>
I understand that much. I don't quite understand why.
<ski__>
(i say "probably" above, because i haven't seen the implementation or tested `Lazy' for this issue)
<Yoric[DT]>
ok
<schme>
Sorry to interrupt here, but does anyone have anything to say about "The Objective Caml Programming Language" - Tim Rentsch . Amazon suggested it to me, but no reviews or anything going on there.
<Yoric[DT]>
That's the new book, isn't it?
<Yoric[DT]>
I don't know of anyone who has read it.
<flux>
schme, isn't that a very recent book? I haven't heard of anyone actually reading it, yet..
<schme>
Hmmm... Sept 5, 2008
<schme>
So pretty new ya :)
<schme>
Well that's a buy + review then.
<schme>
Thanks!
<flux>
schme, be sure to tell us :)
<schme>
Will do.
<ski__>
Yoric[DT] : if you refer to `Enum.slazy' by `delayed', then that just appears to cache the result of the provided thunk
<Yoric[DT]>
ski__: no, I meant [Enum.delay] but it's probably a synonym for [slazy].
<ski__>
it is, yes
* Yoric[DT]
will take a look at this Scheme paper.
<kaustuv>
Yoric[DT]: LazyList.nil should also be Lazy.lazy_from_val Nil
<ski__>
just to make clear of what i refer to in `filter' i will show alternate implementation, ok ?
<Yoric[DT]>
kaustuv: ok, fixed
<ski__>
let filter f l =
<ski__>
let rec aux rest = lazy (
<ski__>
match next rest with
<ski__>
| Cons (x, t) when f x -> Cons (x, aux t)
<ski__>
| Cons (_, t) -> force (aux t)
<ski__>
| Nil -> Nil
<ski__>
)
<ski__>
in
<ski__>
in aux l
<ski__>
(er, scrap the repeated `in')
<Yoric[DT]>
(as for Scheme's lazy, I have the feeling that we can't import it into OCaml without breaking Lazy)
<ski__>
the problem here is that if lots of elements are removed after one another, then a long chain of `force' and `lazy' will build up
<Yoric[DT]>
I understand.
* Yoric[DT]
will return in about 5 minutes.
<kaustuv>
fwiw, this is what I thought filter should be. I still don't understand why it's wrong.
<kaustuv>
let rec filter f l = lazy begin
<kaustuv>
match next_true f l with
<kaustuv>
| Cons (x, l) -> Cons (x, filter f l)
<kaustuv>
| Nil -> Nil
<kaustuv>
end
<kaustuv>
and next_true f l = match next l with
<kaustuv>
| Cons (x, l) when not (f x) -> next_true f l
<kaustuv>
| l -> l
<ski__>
Yoric[DT] : yes, `Lazy.t' would have to be modified to fix this (potential) issue connected to the `lazy' primitive mentioned in the SRFI above
<ski__>
i'm obviously not claiming this is your responsibility. however i'd like to raise awareness about this
* Yoric[DT]
is back.
<Yoric[DT]>
That's good, because I'm not taking responsibility :)
<ski__>
kaustuv : thank you for showing me that it is possible to fix this in the `filter' case with the current primitives
<ski__>
(of course, i'm not convinced this is possible for other useful operations :)
<ski__>
kaustuv : however, can you implement this, *without* referring to the internal representation of `LazyList.t' ?
<kaustuv>
ski__: I conjecture that LazyList.get is enough. Testing...
<ski__>
(say J. R. Hacker wants to do her/his own custom stream operation .. without being able to / wanting to depend on the current representation of `LazyList.t' .. can you provide her/him with general primitives which enables this ?)=
<kaustuv>
(Although that can be seen as cheating...)
<ski__>
(yes .. i'm not sure about that)
<ski__>
(also, the same issue would reappear in other lazy data types)
<kaustuv>
Yeah, you're right, I can't do it without knowing the representation of 'a LazyList.t
<Yoric[DT]>
Also note that OCaml's [lazy] is thread-safe, which I believe would make things slightly more complicated.
<Yoric[DT]>
(now, that's probably not necessary for lazy lists)
<ski__>
(yes .. that reminds me that there might be semantics changes required in corner cases with mixing `Lazy.t' with side-effects, to change to an implementation supporting the wanted feature)
<ski__>
(implementation of `Lazy.t', i.e.)
<kaustuv>
ski__: I can do it if I had an additional operator lcons : 'a -> 'a t Lazy.t -> 'a t. Is using that cheating?
<bluestorm>
Yoric[DT]: you should make sure to comment on those difficulties you're having now in the source
<bluestorm>
(and should we check for similar issues with Enum ?)
<Yoric[DT]>
bluestorm: I can't systematize this enough for commenting.
<Yoric[DT]>
(and I don't think we should have similar issues with Enum, there's no such thing as caching results in Enum)
<Yoric[DT]>
(or more precisely, never more than one result)
<Yoric[DT]>
(of course, I'm not 100% sure)
<bluestorm>
hm
<bluestorm>
is it a problem for someone if I get rid of both the Camlp4ListComprehension dependency and the list-only [ ... | .. ] syntax for comprehensions ?
<ski__>
kaustuv : i believe an additional operation lazy_list : 'a t Lazy.t -> 'a t would be workable
<ski__>
(i believe that operation would be more appropriate than your `lcons')
<ski__>
however, i'm not sure of nicer way to do this, apart from language support for declaring some datatypes as "lazy", and providing special declaration syntax for declarations returning values in "lazy" types
<kaustuv>
ski__: ah yes, you're right. Using lcons is a bit over-eager.
<ski__>
(istr SML/NJ had such a special declaration syntax extension at least for it's equivalent of `Lazy.t' .. but i can't seem to find it in the docs, atm)
<ski__>
basically something like
<ski__>
let lazy f x = match x of ...
<ski__>
would define `f', but add an invisible `lazy' primitive (in the SRFI sense) before pattern-matching
<ski__>
(though possibly this wouldn't be that needed in O'Caml, since iirc, you can't define a function by cases without using `match' or `function' ..)
<kaustuv>
in sml/nj, if you write:
<kaustuv>
datatype lazy 'a llist = Nil | Cons of 'a * 'a llist
<kaustuv>
it is desugared as:
<kaustuv>
datatype 'a llist_ = Nil | Cons of 'a * 'a llist
<kaustuv>
withtype 'a llist = 'a llist_ susp
<kaustuv>
so it is equivalent to ocaml's what we have in ocaml.
Alpounet_ has joined #ocaml
<ski__>
yes, possibly you can then define
<kaustuv>
and fun lazy matches up exactly as datatype lazy
<ski__>
fun lazy filter p Nil = Nil | filter p (Cons (h,t)) = ...
<kaustuv>
Exactly.
* ski__
hasn't a recent SML/NJ available here to test ..
<ski__>
ok (ty for confirming what i seemed to recall)
<ski__>
so what if you define
<ski__>
fun lazy f () = if false then () else f ();
<ski__>
?
<kaustuv>
same as ocaml's let rec f () = lazy (if false () then Lazy.force (f ()))
<kaustuv>
err, if false then () else ...
<ski__>
do you get an error when trying to define this ?
<ski__>
if not, what type does `f' have ?
<kaustuv>
- fun lazy f () = f () ;;
<kaustuv>
val f = fn : unit -> 'a ?.susp
<kaustuv>
val f_ = fn : unit -> 'a
<kaustuv>
(ocaml is infecting my brain. that ;; should be ;)
<ski__>
please add the `if false then () else' part (which was to force the result type into `unit')
<Yoric[DT]>
bluestorm: good for me.
<kaustuv>
that's a type error, obviously
<Yoric[DT]>
Uniform comprehension is quite sufficient.
<ski__>
ok
<Yoric[DT]>
bluestorm: Of course, a syntax for lazy lists would be nice (not comprehension, just definition and pattern-matching).
<ski__>
so it appears you have to expose the implementation of `llist' as containing an outer `susp' to be able to use `fun lazy ...'
<bluestorm>
hm
<kaustuv>
ski__: Yes, the desugaring that exposes the susp is done in the signature as well.
* ski__
would prefer something like lazy type 't llist in the signature
<ski__>
(i'm not saying this would necessarily be an ideal solution .. just not seeing anything better)
<bluestorm>
i don't see what's wrong with exposing a lazy list implementation
ziman has joined #ocaml
<bluestorm>
exposing ADT implementation is standard practice in the ML world and afaik it is not a huge problem on "simple" types
<ski__>
suppose a module exports various (abstract) types
<ski__>
one might not want to expose exactly where one has inserted `Lazy.t' in the representation types
<ziman>
hello, what's the way to go to do socket programming in OCaml? Do I have to use the Unix module or is there something higher-level?
<ski__>
(also, for functors, exposing representation types in the functor arguments is yet more problematic, in general)
nuncanada has joined #ocaml
<kaustuv>
ziman: ocamlnet is the canonical answer unless you like mucking around with the Unix socket api. http://ocamlnet.sourceforge.net/
<Yoric[DT]>
ziman: depends on what you want to do.
<ski__>
anyway, thanks for listening to this arguably a little bit abstract issue
<Yoric[DT]>
ziman: typically, ocamlnet
<Yoric[DT]>
ski__: well, until we have proper "views" in OCaml, there's not much we can do, is there?
<ski__>
(Yoric[DT] : i how you'll forgive me if i don't check the rest of `LazyList' (being tired atm) for just-a-little-bit-too-eager operations (or ones potentially having this `lazy' issue) ?)
<Yoric[DT]>
ski__: of course :)
<ski__>
Yoric[DT] : agreed
<Yoric[DT]>
If you wish to pursue the code review later, don't hesitate, though.
<ski__>
(obviously s/how/hope/)
<ski__>
i might
Alpounet has quit [Read error: 110 (Connection timed out)]
<ski__>
(but what one can do, imho, should be done, if not too cumbersome)
* ski__
goes to fetch something edible
slash_ has joined #ocaml
<ziman>
kaustuv, Yoric[DT], thanks, i'll take a look. I'm writing a web server, a web crawler and a simple chat server (it's a school assignment). The only thing I was able to google was Unix, which is a bit... uncomfortable to use :) I just wanted a socket api without explicit buffers and other lowlevel stuff.
<Yoric[DT]>
Well, OCamlnet is meant specially for Internet clients or servers.
<kaustuv>
ziman: You should take a look at ocsigen, which already implements a web server
<Yoric[DT]>
(there's also Lwt/Ocsigen, for approximately the same purpose, just more modern)
<kaustuv>
Ocsigen is very good, by the way. I would love to see Lwt incorporated into Batteries.
<Yoric[DT]>
You're not the only one.
<Yoric[DT]>
I don't think there's a RfF on this subject yet, though.
<Yoric[DT]>
Don't hesitate to add one :)
<kaustuv>
Done.
<kaustuv>
Ugh, stupid typo in title.
tripwyre has joined #ocaml
ttamttam1 has joined #ocaml
<ttamttam1>
99+ 1 = 100 :-)
thelema has quit [Read error: 110 (Connection timed out)]
<ttamttam1>
join #ocamlfr
Camarade_Tux has quit [Read error: 110 (Connection timed out)]
Camarade_Tux has joined #ocaml
_zack has quit [Read error: 60 (Operation timed out)]
Ariens_Hyperion has joined #ocaml
munga has joined #ocaml
munga has quit [Remote closed the connection]
Cheshire has quit [Read error: 104 (Connection reset by peer)]
jah has joined #ocaml
xevz has quit [Read error: 60 (Operation timed out)]
Cheshire has joined #ocaml
vuln has joined #ocaml
Smerdyakov has quit ["Leaving"]
xevz has joined #ocaml
_zack has joined #ocaml
tripwyre has quit []
realtime has left #ocaml []
jah has quit ["Quitte"]
Cheshire has quit [Read error: 113 (No route to host)]
bluestorm has quit [Remote closed the connection]
xevz__ has joined #ocaml
xevz__ is now known as xevz_
ygrek has quit [Remote closed the connection]
xevz has quit [Read error: 110 (Connection timed out)]
xevz_ is now known as xevz
Cheshire has joined #ocaml
Cheshire has quit [Client Quit]
love-pingoo has joined #ocaml
Cheshire has joined #ocaml
AxleLonghorn has joined #ocaml
ttamttam1 has left #ocaml []
pango has joined #ocaml
seafood has joined #ocaml
ziman has left #ocaml []
slash_ has quit ["leaving"]
_zack has quit ["Leaving."]
hkBst has quit [Read error: 104 (Connection reset by peer)]
vuln has quit ["leaving"]
flx_ has joined #ocaml
kig has quit [Read error: 104 (Connection reset by peer)]
kig has joined #ocaml
flux has quit [Read error: 104 (Connection reset by peer)]
jonasb_ has joined #ocaml
jonasb has quit [Read error: 110 (Connection timed out)]
Ariens_Hyperion has quit []
ikaros has quit [".quit"]
Alpounet has joined #ocaml
jonasb_ has quit [Remote closed the connection]
Alpounet_ has quit [Read error: 110 (Connection timed out)]