middayc has quit [Read error: 104 (Connection reset by peer)]
jlouis has joined #ocaml
Snrrrub has joined #ocaml
middayc has joined #ocaml
<Snrrrub>
What's a good way to store an OCaml closure from C code without having it garbage collected?
<Snrrrub>
I'd use Callback.register but I don't want to use a string to refer to the code because I'd have to create a new, unique string every time my native code was called with a closure
<Snrrrub>
Basically what I'm trying to do is pass in a closure to a C function, store that closure somewhere along and return an opaque handle to a native resource, and eventually, another C function will take that handle and call the closure
<thelema>
You want to pass a OCaml closure to C code without it disappearing on the OCaml side?
<thelema>
hmm...
<Snrrrub>
thelema, yeah!
<thelema>
normally I'd say "make a copy", but you can't do that for closures so much...
<Snrrrub>
Is there a way of telling the GC that I'm still holding on to the closure?
<thelema>
I think you're running into rule 4: Global variables containing values must be registered with the garbage collector using the register_global_root function.
<Snrrrub>
Hmm, maybe I can return an array with my native handle and closure and return THAT as an opaque data type?
<thelema>
that may work...
hsuh has quit [Remote closed the connection]
<Snrrrub>
Thanks for the rule 4 idea, thelema. :)
<thelema>
be aware that if the GC works harder the more roots you have registered
jlouis has quit [Remote closed the connection]
jlouis has joined #ocaml
mwc has quit ["Leaving"]
jlouis has quit [Remote closed the connection]
jlouis has joined #ocaml
thermoplyae has quit ["daddy's in space"]
jlouis has quit [Remote closed the connection]
jlouis has joined #ocaml
brooksbp has joined #ocaml
jlouis has quit [Remote closed the connection]
jlouis has joined #ocaml
jlouis has quit [Remote closed the connection]
jlouis has joined #ocaml
thermoplyae has joined #ocaml
jlouis has quit [Remote closed the connection]
jlouis has joined #ocaml
Snrrrub has quit [Read error: 104 (Connection reset by peer)]
jlouis has quit [Remote closed the connection]
jlouis has joined #ocaml
jlouis has quit [Remote closed the connection]
jlouis has joined #ocaml
jlouis has quit [Remote closed the connection]
jlouis has joined #ocaml
jlouis has quit [Remote closed the connection]
jlouis has joined #ocaml
jlouis has quit [Remote closed the connection]
jlouis has joined #ocaml
jlouis has quit [Remote closed the connection]
jderque has joined #ocaml
jlouis has joined #ocaml
middayc has quit []
jlouis has quit [Remote closed the connection]
jlouis has joined #ocaml
jlouis has quit [Remote closed the connection]
jlouis has joined #ocaml
jlouis has quit [Remote closed the connection]
mwc has joined #ocaml
jlouis has joined #ocaml
jlouis has quit [Remote closed the connection]
jlouis has joined #ocaml
jlouis has quit [Remote closed the connection]
jlouis has joined #ocaml
pattern has quit [Remote closed the connection]
pattern has joined #ocaml
jlouis has quit [Remote closed the connection]
jlouis_ has joined #ocaml
jlouis_ has quit [Remote closed the connection]
jlouis has joined #ocaml
ttamttam has joined #ocaml
jlouis has quit [Remote closed the connection]
__suri has joined #ocaml
jlouis has joined #ocaml
thermoplyae has quit ["daddy's in space"]
jlouis has quit [Remote closed the connection]
jlouis has joined #ocaml
ttamttam has left #ocaml []
mwc has quit ["Leaving"]
ttamttam has joined #ocaml
jlouis has quit [Remote closed the connection]
jlouis has joined #ocaml
jlouis has quit [Remote closed the connection]
jlouis has joined #ocaml
jderque has quit [Read error: 113 (No route to host)]
jlouis has quit [Remote closed the connection]
brooksbp has quit []
thelema has quit [Read error: 110 (Connection timed out)]
AxleLonghorn has left #ocaml []
jlouis has joined #ocaml
bla has quit [Read error: 113 (No route to host)]
jlouis has quit [Remote closed the connection]
jlouis has joined #ocaml
pattern has quit [Remote closed the connection]
bla has joined #ocaml
jlouis has quit [Remote closed the connection]
jlouis has joined #ocaml
pattern has joined #ocaml
jlouis has quit [Remote closed the connection]
jlouis has joined #ocaml
filp has joined #ocaml
pattern has quit [Remote closed the connection]
TheLittlePrince has quit [Client Quit]
jlouis has quit [Remote closed the connection]
jlouis has joined #ocaml
Yoric[DT] has joined #ocaml
<Yoric[DT]>
hi
jlouis has quit [Remote closed the connection]
jlouis has joined #ocaml
jlouis has quit [Remote closed the connection]
jlouis has joined #ocaml
jlouis has quit [Remote closed the connection]
Tetsuo has joined #ocaml
jlouis has joined #ocaml
|Catch22| has quit []
jlouis has quit [Remote closed the connection]
jlouis has joined #ocaml
jlouis has quit [Remote closed the connection]
jlouis has joined #ocaml
jlouis has quit [Remote closed the connection]
jlouis has joined #ocaml
seafood_ has quit []
Yoric[DT] has quit ["Ex-Chat"]
OChameau has joined #ocaml
seafood_ has joined #ocaml
hkBst has joined #ocaml
hkBst has quit [Connection timed out]
hkBst has joined #ocaml
hsuh has joined #ocaml
middayc has joined #ocaml
hsuh has quit ["work"]
seafood_ has quit []
filp has quit ["Bye"]
filp has joined #ocaml
Yoric[DT] has joined #ocaml
<Yoric[DT]>
hi again
olleolleolle has joined #ocaml
seafood_ has joined #ocaml
jonathanv has joined #ocaml
jonafan has quit [Read error: 110 (Connection timed out)]
seafood_ has quit []
olleolleolle has left #ocaml []
<flux>
has it been tried that an ocaml program would generate a function with llvm and then execute it?
middayc has quit []
<flux>
are there integer precision matrix libraries for ocaml?
<flux>
(fast ones)
<flux>
(infact, those two questions are related: how to do fast multiplication with a fixed matrix.. but perhaps a matrix library would still be nicer than generating code to do it)
<Yoric[DT]>
Isn
<Yoric[DT]>
Is lapack what you're looking for ?
<Yoric[DT]>
I'm pretty sure I saw an OCaml binding.
<flux>
yeah, but does it do integer matrices?
<flux>
doesn't look like that to me.. but the interfaces are quit complicated, perhaps the examples would show that
<flux>
(or plain familiarity with the native lapack library)
jnkm has quit ["Oops"]
middayc has joined #ocaml
letrec has joined #ocaml
pattern has joined #ocaml
mattam has quit [Read error: 104 (Connection reset by peer)]
Yoric[DT] has quit [Read error: 110 (Connection timed out)]
bluestorm has joined #ocaml
marmottine has joined #ocaml
RobertFischer has joined #ocaml
Snrrrub has joined #ocaml
<Snrrrub>
I often see code of the form: let _ = (* bunch of code *);; Why is that style used over having the contents outside the let-binding?
<bluestorm>
Snrrrub: usual caml code is composed of declarations
<bluestorm>
(including types, modules and class declaration)
mattam has joined #ocaml
<bluestorm>
you _can_ use an alone expression as an ocaml sentence
<bluestorm>
but you won't do that more than one usually, and it may be syntaxically ambiguous
<bluestorm>
thus, most people prefer to put those expressions inside a "fake declaration", eg. let _ = or let () = ...
<bluestorm>
(what i call "ocaml sentence" is actually a module expression, ie. the things "at the toplevel")
<bluestorm>
("structure item" is used too, iirc)
<bluestorm>
Snrrrub: in case the type of the bunch of code is unit, i favor let () = ... over let _ = ...
<bluestorm>
as let _ = can be used as a polymorphic "ignore" too, i think it should be restricted to that meaning
<bluestorm>
but it's all a matter of conventions
<Snrrrub>
Thanks for the explanation :-) It's nice to understand the reasoning behind certain code styles/idioms instead of just following blindly.
<letrec>
bluestorm: so let () = <expr>;; is equivellent to <expr> ?
<bluestorm>
to expr;; ?
<bluestorm>
i think it is
<bluestorm>
if expr's type is unit, of course
<bluestorm>
otherwise you'll get a type error
<bluestorm>
(wich is, in some cases, nice)
<letrec>
Ok, and I saw stuff like let f () = ...
<letrec>
What is the type of f?
<bla>
Thats a function declaration.
<bla>
let f () = 2 is unit -> int
<letrec>
But () is not a parameter, surrenly?
<bluestorm>
yes it is
<rwmjones>
letrec, () is a parameter
<rwmjones>
() ;;
<xavierbot>
- : unit = ()
<letrec>
Why not write let f x = 2 ?
<bla>
x gets a 'a type
<bla>
Not a unit.
<rwmjones>
letrec, you could also write:
<rwmjones>
let _ = expr
<bla>
(So f "bleh" becomes valid.)
<letrec>
Yes, but 'a can be resolved to unit by type inference?
<rwmjones>
but then you're not checking if the return value of expr is unit, which you'd expect
<rwmjones>
open Printf;;
<rwmjones>
let () = printf "foo\n" ;;
<xavierbot>
foo
<bluestorm>
you could write let f (x : unit) = 2
<bluestorm>
it's equivalent to let f () = 2, as () is the only value of type unit, and is a constructor
<bluestorm>
(in "let f () = ...", () is in a pattern matching)
<letrec>
Ok, thanks, I think I get the idea. It's let f x = 2 with the constraint that x has type unit.
<Snrrrub>
Is there a shorter way to write the expression: function x -> function y -> x * y or is that the shortest it gets while still being anonymous and curried?
<bla>
letrec, it's often used when you want to define function taking no parameters, and when you've got optional parameters to function.
<bla>
letrec, let f ?(x=5) () = x + 5;;
<xavierbot>
Characters 31-32:
<xavierbot>
Parse error: "in" expected after [binding] (in [expr])
<xavierbot>
letrec, let f ?(x=5) () = x + 5;;
<xavierbot>
^
<bla>
Uhm.
<bluestorm>
hm
<bluestorm>
let f ?(x=5) () = x + 5;;
<xavierbot>
val f : ?x:int -> unit -> int = <fun>
<bluestorm>
:]
<bla>
;-)
<bla>
Will it be defined now?
<bla>
f ();;
<xavierbot>
- : int = 10
<bla>
f ~x:10 () ;;
<xavierbot>
- : int = 15
<bla>
(Cool)
<letrec>
Ok, so a function taking only unit as parameter has some kind of side-effect (closure or...). Otherwise I don't see what the use :)
<bla>
Yes. Or some kind of lazy variable.
<hcarty>
Or a default value, like bluestorm's example
<bluestorm>
that was bla's example actually
<hcarty>
Oops, sorry
<bluestorm>
letrec: note that you can do very interesting things with closures and side effets
<letrec>
Snrrrub: Why can't you use fun x y -> x,y ?
<bluestorm>
for example you can have the equivalent of "static" variables in C-like languages
<rwmjones>
I'm only half-following this conversation, but if the parameter wasn't required then you couldn't make f into a closure
<bluestorm>
let uniqid = let counter = ref (-1) in fun () -> incr counter; !counter;;
<xavierbot>
val uniqid : unit -> int = <fun>
<rwmjones>
writing 'f' would apply the function (or something)
<bluestorm>
uniqid ();;
<xavierbot>
- : int = 0
<bluestorm>
uniqid ();;
<xavierbot>
- : int = 1
<bluestorm>
uniqid ();;
<xavierbot>
- : int = 2
<letrec>
bluestorm: any pointer on that?
<letrec>
I'm interested
<bla>
Snrrrub, and btw. You can use 'fun' if using standard syntax...
<bluestorm>
letrec: that was a live example :-'
<Snrrrub>
letrec, aha, so that's the difference between 'fun' and 'function'! :D
<letrec>
bluestorm: :) Let me think hard now. I didn't even notice!
<bluestorm>
Snrrrub: function are intended for pattern matching of one (implicit) parameter
<bluestorm>
(it's not really implicit, but it's not named until you match it with a named pattern)
<letrec>
Snrrrub: today is my first day with ocaml so don't be too hard. By fun stuff doesn't work?
<bluestorm>
on the other side "fun" doesn't support multi-pattern matching, but can have multiple parameters
<Snrrrub>
letrec, it does the right thing
<Snrrrub>
bluestorm, thanks! That makes sense.
<letrec>
bluestorm: the 'environmental' part of the closure is the 'counter' reference then?
<bluestorm>
letrec: yes it is
<bluestorm>
and as it's a "local" variable, it's kinda "private"
<bla>
If you are used to objective programming you can possibly compare such closure to object with private fields, but... I would be careful.
<letrec>
Why are closures usefull abstractions? Besides defining a local environment, I can't see the use. Especially, how can you reason on closures in a program?
<letrec>
(I know, large question :)
<bluestorm>
hm
<bluestorm>
letrec: we have *simple* concepts
<flux>
letrec, I don't have a good answer for that, but think doing Continuation Passing Style -programming without closurs:
<flux>
read_input \value ->
<flux>
uh, haskell-style :-)
<bluestorm>
statically scoped variables and anonymous functions
<bluestorm>
and we can create something you call "closure" from that
<bluestorm>
but it's not an "abstraction" per se
<bla>
In mine ocaml raytracer I used them in a function from module Camera. That function, when called calculated some data first and then returned a function which was suitable for generatting rays for specified x,y, point. By the use of closures that additional data was calculated once, but function was called MANY times (640*480 times)
<bluestorm>
it's just a lambda expression after a local variable
<flux>
read_input @@ fun value1 -> \n read_input @@ fun value2 -> \n write_output (input1 + input2)
<flux>
read_input is a function that actually returns a request to read from something, and the rest of the system takes care that the function read_input wishes the result go to will be called
<flux>
also, let (@@) a b = a b;;
<xavierbot>
also, let (@@) a b = a b;;
<xavierbot>
^
<xavierbot>
Characters 24-25:
<xavierbot>
Parse error: "in" expected after [binding] (in [expr])
<flux>
oh, he's here again!
<bluestorm>
you shouldn't put text before the phrase
<bluestorm>
hm
<Snrrrub>
My take on it is that a closure brings along, implicitly, all of its data dependencies so you won't hit an inconsistent state (e.g. values no longer present) when you apply the closure.
SIGVTALRM is now known as mfp
<bla>
Bot is nice; but there could be some character to catch his attention (like double %%... or something)
<bluestorm>
it may be useful to ask for a "#" at the beginning of the xavierbot expressions
<Snrrrub>
Or rather, data and code dependencies.
<flux>
I think the current version is fine. I sort of was wishing that it was here, hence the ;;, but "knowing" it wasn't, hence the "also, " :-)
<RobertFischer>
Does anyone have a link to some useful documentation on the Ocaml VM?
<letrec>
The way to define a closure is: let theclosure = let a = ... and let b = ... in fun x -> f a b x where f is a pure function then?
<bluestorm>
hm
<bluestorm>
probably
<bluestorm>
letrec: aren't you trying to apply an external concept, ie. "closure", to something simple and "natural" in OCaml ?
postalchris has joined #ocaml
<RobertFischer>
I suppose camlp4 is probably more what I'm thinking about, but...
<bluestorm>
i've personally used this kind of things long before learning about the word "closure"
<bluestorm>
and i'm not sure it's a concept _that_ useful, actually
<bla>
Yeah. That's something more/less internal. You just have to know that functions carry their environment with them.
<bluestorm>
bla: hm, what do you mean by "environnement" ?
<bla>
I liked -dinstr command to ocaml from one of the links above... When you will do: ocaml -dinstr; and then enter code:
<bla>
(fun x -> x + 1) 42;;
<xavierbot>
- : int = 43
<letrec>
bluestorm: yes, it might well be, and I personally don't really need to know what a closure is. But I've been talking to people who use 'closure' all the time, and I'd like to understand !
<bluestorm>
i only see the usual rules of static binding here
thelema has joined #ocaml
<bla>
It will show bytecode fragment, which uses 'closure' mnemonic even in this example.
<bluestorm>
letrec: as bla said, it's when a function captured a part of his environment
<letrec>
ok, I'll stick with that definition, thx.
<bluestorm>
the exemple of uniqid() i gave may well be a good example of closure, where the focus is on the reference, wich is part of the "environnement"
<bla>
Hmh.
middayc_ has joined #ocaml
Morphous_ has joined #ocaml
<letrec>
bluestorm: I define let play x () = let i = x () in print_int i; print_newline ();; let c1 = play uniq;; let c2 = play uniq;;
<xavierbot>
Characters 1-10:
<xavierbot>
bluestorm: I define let play x () = let i = x () in print_int i; print_newline ();; let c1 = play uniq;; let c2 = play uniq;;
<xavierbot>
^^^^^^^^^
<xavierbot>
Unbound value bluestorm
<xavierbot>
Characters 10-11:
<xavierbot>
Parse error: illegal begin of top_phrase
<bluestorm>
:D
<bluestorm>
[17:25:07] <xavierbot> Unbound value bluestorm
<bluestorm>
what a strange HL !
<letrec>
When I do c1 ();; I get 6
<letrec>
When I do c2 ();; I get 7
<letrec>
I would have expected to get the same number
<bluestorm>
hm
<bla>
type Ircer = Bluestorm | OtherIrcer of string;;
<xavierbot>
type Ircer = Bluestorm | OtherIrcer of string;;
<xavierbot>
^^^^^
<xavierbot>
Characters 6-11:
<xavierbot>
Parse error: [type_declaration] expected after "type" (in [str_item])
<bluestorm>
you shouldn't
<bla>
Duh.
<letrec>
(Because I passed the same closure twice)
<bluestorm>
if you defined uniq as mine
<bla>
type ircer = Bluestorm | OtherIrcer of string;;
<xavierbot>
type ircer = Bluestorm | OtherIrcer of string
<bluestorm>
it _really_ produces a different number each time
<letrec>
Yes I see. But why?
<bluestorm>
hm
<bla>
let bluestorm = Bluestorm;;
<xavierbot>
val bluestorm : ircer = Bluestorm
<bluestorm>
why would it not ?
ahf has quit [Remote closed the connection]
<letrec>
I passed twice the same closure (e.g. with same environment).
ahf has joined #ocaml
<bluestorm>
bla: for extensibility, i think a generic "IRCer of string" is better
<bluestorm>
letrec: hm
<bla>
let bla = OtherIrcer "bla";;
<xavierbot>
val bla : ircer = OtherIrcer "bla"
<bluestorm>
i don't understand why you could expect to get the same number
<bla>
Here you are. But type could be better...
<bluestorm>
it's a shame to have a magical Bluestorm value :-'
<bla>
:D
<bla>
I know.
<bla>
It easies mathing.
<bla>
let talk = function Bluestorm -> failwith "NOOOOO" | OtherIrcer c -> Printf.printf "Hello %s" c;;
<xavierbot>
val talk : ircer -> unit = <fun>
<bluestorm>
letrec: you wrote "uniq" in two different place
<bla>
talk bluestorm;;
<xavierbot>
Exception: Failure "NOOOOO".
<bluestorm>
so what ?
<letrec>
bluestorm: because I constructed c1 and c2, two functions that are independant.
<bluestorm>
it's still the same function, with the same hidden reference
<bluestorm>
letrec: but they share the same "uniq" function, ie. the same hidden reference
<bluestorm>
wich get updated for both
middayc has quit [Read error: 110 (Connection timed out)]
<bluestorm>
how could it do differently ?
<bluestorm>
of course you could
<bluestorm>
create a "counter farm"
<letrec>
Ok, I see. The reference is still the same. If I rewrite with a mutable field, this would solve it?
<bluestorm>
let create_uniq () = let counter = ref (-1) in fun () -> incr counter; counter;;
<xavierbot>
val create_uniq : unit -> unit -> int ref = <fun>
<bluestorm>
let c1 = create_uniq ();;
<xavierbot>
val c1 : unit -> int ref = <fun>
<bluestorm>
let c2 = create_uniq ();;
<xavierbot>
val c2 : unit -> int ref = <fun>
<bluestorm>
c1();;
<xavierbot>
- : int ref = {contents = 0}
<bluestorm>
argh
<bluestorm>
let create_uniq () = let counter = ref (-1) in fun () -> incr counter; !counter;;
<xavierbot>
val create_uniq : unit -> unit -> int = <fun>
<bluestorm>
let c1, c2 = create_uniq (), create_uniq ();;
<xavierbot>
val c1 : unit -> int = <fun>
<xavierbot>
val c2 : unit -> int = <fun>
<bluestorm>
c1 ();;
<xavierbot>
- : int = 0
<bluestorm>
c1();;
<xavierbot>
- : int = 1
<bluestorm>
c2();;
<xavierbot>
- : int = 0
<bluestorm>
those don't share the same counter
<bluestorm>
as the counter is declared after the first () application, that is, independently for c1 and c2
<letrec>
Ok, yes, sorry, in that case the pointer was the same...
<bla>
and IMHO it's the biggest reason 'behind closures'.
<letrec>
Really? When you pass a closure when a consistent state, you don't want another piece of the program to be able to change that (that's risky).
<letrec>
(with a consistent state)
<bla>
So then you don't use such a construction.
<bluestorm>
letrec: what if you want to ?
<bla>
Also it has limited visibility as any other function.
<bluestorm>
in that case i really wanted to
<bluestorm>
i want the ids to be unique
<bluestorm>
they're not anymore if anyone can "copy" the counter
<bla>
It's a kind of 'singleton'.
<bla>
You can even do something like this (Hopefully I won't spoil it):
Morphous has quit [Read error: 113 (No route to host)]
<bla>
let create () = let x = ref (-1) in ((fun () -> !x), (fun () -> incr x);;
<xavierbot>
let create () = let x = ref (-1) in ((fun () -> !x), (fun () -> incr x);;
<xavierbot>
^
<xavierbot>
Characters 71-72:
<xavierbot>
Parse error: ";" or ":" or ":>" or ")" expected after [expr] (in [expr])
<bla>
let create () = let x = ref (-1) in ((fun () -> !x), (fun () -> incr x));;
<xavierbot>
val create : unit -> (unit -> int) * (unit -> unit) = <fun>
<bla>
let reader, writer = create ();;
<xavierbot>
val reader : unit -> int = <fun>
<xavierbot>
val writer : unit -> unit = <fun>
<bla>
reader ();;
<xavierbot>
- : int = -1
<bla>
reader ();;
<xavierbot>
- : int = -1
<bla>
writer ();;
<xavierbot>
- : unit = ()
<bla>
reader ();;
<xavierbot>
- : int = 0
<bla>
Then you have two functions sharing one reference.
<bla>
You can pass reader to part of program which CAN'T change that value. And it won't.
<bla>
let create () = let x = ref (-1) in ((fun () -> !x), (fun a -> x := a));;
<xavierbot>
val create : unit -> (unit -> int) * (int -> unit) = <fun>
<bla>
let reader, writer = create ();;
<xavierbot>
val reader : unit -> int = <fun>
<xavierbot>
val writer : int -> unit = <fun>
<bla>
writer 30;;
<xavierbot>
- : unit = ()
<bla>
reader ();
<bla>
Kind of pipe.
<bluestorm>
reader ();;
<xavierbot>
- : int = 30
<mfp>
let (record, timezone) = let l = ref [] in (fun x y -> l := (x,y) :: !l), (fun x -> List.assoc x !l);;
<xavierbot>
val record : '_a -> '_b -> unit = <fun>
<xavierbot>
val timezone : '_a -> '_b = <fun>
<mfp>
record `bluestorm "CET";;
<xavierbot>
- : unit = ()
<bluestorm>
weak types :-'
<mfp>
timezone `bluestorm;;
<letrec>
Ok, thanks.. It helps, that's how you 'control' what a program does. And The reference is hidden from the program. Interesting.
<xavierbot>
- : string = "CET"
<mfp>
here you go, '_a and '_b instantiated
<bluestorm>
letrec: the interesting part is that there is no real "hiding" idea
<bluestorm>
it's *just* a local binding
<bluestorm>
i mean
<bla>
Yeah.
<bluestorm>
if you know the rules of local scoping and anonymous functions, you can do all that
<bluestorm>
you don't have to add new fishy concept like "private values" or "static variables" or what else
<bla>
It is clean functional concept.
<letrec>
I see, you don't need to hide it explicitely. The rules of binding make that happen.
<bluestorm>
if you end up using one of this traits heavily in a particular program, you may want to give it a name (as a locally useful programming pattern)
<bluestorm>
but generally i don't think it's that important to give names like "hiding references", "closures", "environments" or such things
<bluestorm>
they're just bindings
filp has quit ["Bye"]
l_a_m has quit [Read error: 110 (Connection timed out)]
<bla>
talk (OtherIrcer "bla");;
<xavierbot>
Hello bla- : unit = ()
<bla>
So lonely...
<bla>
BTW. His 'hacking proofing' could be a bit difficult I guess.
<bla>
Or just removed few modules, chrooted and sanitized IRC output?
robyonrails has joined #ocaml
* rwmjones
missed that
<rwmjones>
what was OtherIrcer?
jonathanv is now known as jonafan
<rwmjones>
OtherIrcer ;;
<xavierbot>
Characters 1-11:
<xavierbot>
OtherIrcer ;;
<xavierbot>
^^^^^^^^^^
<xavierbot>
The constructor OtherIrcer expects 1 argument(s),
<xavierbot>
but is here applied to 0 argument(s)
<rwmjones>
talk ;;
<xavierbot>
- : ircer -> unit = <fun>
<bla>
talk bluestorm;;
<xavierbot>
Exception: Failure "NOOOOO".
<bluestorm>
:D
<jonafan>
last night, i continued my perversion of the c# language and wrote a lazy evaluation class and a basic lazy list library with an infinite fibonacci sequence list
<rwmjones>
and yes, it's defense in depth, but I'm pretty sure there are holes
<rwmjones>
remove unsafe stuff from ocaml; disable standard functions; enable only "safe" modules; then chroot and chown the whole thing
<rwmjones>
oh and use rlimits
<bla>
I guess it's not so hard to dos it.
<rwmjones>
it has some flood protection
<rwmjones>
and won't use more than 16 MB of RAM IIRC and 4 processes
<bla>
But it won't do threads?
<bla>
Ah, i'll see the code.
<mfp>
you can segfault it with CamlinternalOO trivially (get rid of it! :)
<rwmjones>
I don't think so
<rwmjones>
really?
<rwmjones>
so CamlinternalOO is unsafe then ...
<bla>
let rec f () = print_endline "hmm"; f ();;
<xavierbot>
val f : unit -> 'a = <fun>
<mfp>
let t = public_method_label "foo" in let o = create_object (dummy_table) in send o t ...
<bla>
However it has limits for things like that?
<rwmjones>
unfortunately you need it, or some of it, for objects to work at all
<rwmjones>
let loop () = loop () in loop () ;;
<xavierbot>
Characters 15-19:
<xavierbot>
let loop () = loop () in loop () ;;
<xavierbot>
^^^^
<xavierbot>
Unbound value loop
<rwmjones>
let rec loop () = loop () in loop () ;;
<xavierbot>
Objective Caml version 3.10.0
<xavierbot>
Camlp4 Parsing version 3.10.0
<rwmjones>
rlimit stops it from using more than 10 secs of CPU
<bla>
;)
<rwmjones>
open CamlinternalOO;;
<rwmjones>
let t = public_method_label "foo" in let o = create_object (dummy_table) in send o t ;;
<xavierbot>
Objective Caml version 3.10.0
<xavierbot>
Camlp4 Parsing version 3.10.0
<rwmjones>
hmmm not great
<rwmjones>
the question is though, can you overwrite random pieces of memory with that?
<bla>
I wonder about 'magic' or is it limited?
<rwmjones>
Obj.magic;;
<xavierbot>
Characters 0-9:
<xavierbot>
Obj.magic;;
<xavierbot>
^^^^^^^^^
<xavierbot>
Unbound value Obj.magic
<rwmjones>
Obj isn't included
<bla>
Ok.
<rwmjones>
Array.unsafe;;
<xavierbot>
Characters 1-13:
<xavierbot>
Array.unsafe;;
<xavierbot>
^^^^^^^^^^^^
<xavierbot>
Unbound value Array.unsafe
<rwmjones>
Array.unsafe_get;;
<xavierbot>
Characters 1-17:
<xavierbot>
Array.unsafe_get;;
<xavierbot>
^^^^^^^^^^^^^^^^
<xavierbot>
Unbound value Array.unsafe_get
<rwmjones>
Array.init ;;
<xavierbot>
- : int -> (int -> 'a) -> 'a array = <fun>
<rwmjones>
some modules are excluded completely, and others are masked using signatures so you can only get to safe functions
xavierbot has quit [Remote closed the connection]
xavierbot has joined #ocaml
<rwmjones>
let obj = object method foo = print_endline "hello" end ;;
<xavierbot>
val obj : < foo : unit > = <obj>
<rwmjones>
obj#foo;;
<xavierbot>
hello
<xavierbot>
- : unit = ()
<rwmjones>
open CamlinternalOO;;
<rwmjones>
let t = public_method_label "foo" in let o = create_object (dummy_table) in send o t ;;
<xavierbot>
Characters 9-28:
<xavierbot>
let t = public_method_label "foo" in let o = create_object (dummy_table) in send o t ;;
<xavierbot>
^^^^^^^^^^^^^^^^^^^
<xavierbot>
Unbound value public_method_label
<rwmjones>
ok, so I've masked out CamlinternalOO now
<bla>
Nice
<mfp>
what did you leave? (I refrain from doing include CamlinternalOO because it'd be too long...)
<mfp>
send;;
<xavierbot>
Characters 1-5:
<xavierbot>
send;;
<xavierbot>
^^^^
<xavierbot>
Unbound value send
<rwmjones>
I masked it with another module called CamlinternalOO which is empty
<rwmjones>
there is no syntactic way to access a masked module
<rwmjones>
I one which appears earlier in the symbol table
<mfp>
yep
<rwmjones>
version 0.8 uploaded
xavierbot has quit [Remote closed the connection]
ttamttam has left #ocaml []
xavierbot has joined #ocaml
<bluestorm>
mfp: note that "module C = CamlinteralOO" is a less cluttering way to print a module interface
<rwmjones>
xavierbot, help
<xavierbot>
hello rwmjones, I am xavierbot 0.8, an OCaml toplevel
<xavierbot>
expr ;; evaluate expr in toplevel and print result
<xavierbot>
help help message
<xavierbot>
restart restart the toplevel
<xavierbot>
sleep go to sleep
<xavierbot>
wake wake me up from sleep
<bla>
rwmjones, can you add to him some required prologue so he won't try to interpret everything which ends in ;;
<xavierbot>
Characters 0-8:
<xavierbot>
rwmjones, can you add to him some required prologue so he won't try to interpret everything which ends in ;;
<xavierbot>
^^^^^^^^
<xavierbot>
Unbound value rwmjones
<xavierbot>
Characters 22-24:
<mfp>
bluestorm: doesn't change the env, but the output is just as long, which is what I cared about
<xavierbot>
Parse error: illegal begin of top_phrase
<bla>
? :)
<bla>
Like #, or %%, or anything.
<Snrrrub>
If I have some code in the top-level of a library, will it get run before an application that links against it?
<bluestorm>
yes you will
<bluestorm>
ocaml evaluate the modules in the command-line order
<bluestorm>
so if you give for example "ocamlc module.cmo yourcode.ml", module.cmo statements will get executed first
<mfp>
I think the answer is "it depends" actually when you're linking against a .cma (some modules are initialized later...)
<bluestorm>
but if you're doing nasty things, you could use at_exit to execute part of Module code at the end
<bluestorm>
it's generally not a good idea, but there are good uses for it
<Snrrrub>
See, I have a .cma but the Printf.printf "Hello world!\n%!";; doesn't run it seems
<Snrrrub>
and my cmdline is: ocamlc testlib.cma foo.ml; ./a.out
<mfp>
Snrrrub: add a ref to that module in some module from your main prog, that'll make the runtime init it and run the top-level code
jderque has joined #ocaml
<Snrrrub>
mfp, I'm actually calling functions inside that module... hmm, maybe I can create a really stripped down version to see what's going on
<rwmjones>
bla # expr is probably a good idea, and it could also allow multi-line syntax (eg. keep building up expr until we get to last line which is # expr ;; )
<bla>
;)
<rwmjones>
a good multiline syntax is something I've been wanting
<bla>
It should nicely work.
<rwmjones>
'course patches to the perl code to do this are welcome :-)
<bla>
I generally like the idea of such a bot. For me it could also work as general bot. With some restrictions etc. ;-) # add_ban "*!bla@afdns.sownet.pl";; # op "bla";; etc. With dynamic scripting.
* bla
known no perl. :)
<rwmjones>
I suspect using something like mozbot is better .. it already does that stuff
<rwmjones>
there's no reason not to have 2 bots in a channel
<bla>
Sure.
Optikal_ has quit [Remote closed the connection]
<thelema>
rwmjones: why not multiline by \
<thelema>
using the c convention\
<thelema>
to do this?
<rwmjones>
could do that as well
<rwmjones>
the main thing is you often want to copy and paste in multiline code
<rwmjones>
and I've not found a good way to express that
<bla>
It can cause that the bot will hang waiting for finishing expression
<bla>
Or you have to have a parser per user.
<bluestorm>
i'm not sure provinding facilities for pasting tons of code into the chan is such a good idea
l_a_m has joined #ocaml
<thelema>
bla: one buffer per user
<rwmjones>
you'd need one buffer per user
<rwmjones>
bluestorm, yes I'm sensitive to that concern
<bla>
You could possibly create some construct on query and demonstrate it on channel.
<bluestorm>
rwmjones: i think the \ idea is decent
<bluestorm>
you could still paste lot of things, but you'd have to do that willingly
<bluestorm>
(and you can already)
<Snrrrub>
Okay, does anyone know where I could find the rules to module loading and running of top-level code?
<bla>
#load "unix.cma";;
<bla>
Hm.
<bla>
Unix.time ();;
<xavierbot>
Characters 1-10:
<xavierbot>
Unix.time ();;
<xavierbot>
^^^^^^^^^
<xavierbot>
Unbound value Unix.time
<rwmjones>
sorry, Unix.* is killed completely
<rwmjones>
even though there are possibly safe functions in there
<bla>
No problem. I supposed it is.
Yoric[DT] has joined #ocaml
jlouis has quit [Read error: 110 (Connection timed out)]
zenhacker-rouan has joined #ocaml
<bla>
Random.int 1000;;
<xavierbot>
- : int = 234
<Snrrrub>
Hmmm, this is really strange. So if I run: ocaml test.cma b.ml, my toplevel code in test.cma runs but if I run ocamlc test.cma b.cmo; ./a.out, my toplevel code doesn't run (even though I construct a type defined in test.cma)
<bla>
Hah. Pseudo-random number generator attack.
<bla>
(-;
<rwmjones>
Snrrrub, code?
<mfp>
Snrrrub: using a type is not enough to init the module I think
<rwmjones>
if this didn't work, _a lot_ of stuff would break
jlouis has joined #ocaml
<rwmjones>
ah right, it's a .cma
<rwmjones>
try loading a .cmo instead
<Snrrrub>
rwmjones, it's fine with the .cmo
<Snrrrub>
So calling a function and using a type aren't enough... so what would be enough?
<mfp>
Snrrrub: try to add some val bogus : int to the module and ignore (Mod.bogus); in the client
<mfp>
works for me in a minimal ex
<mfp>
(w/o ignore (Mod.bogus), the toplevel code isn't executed in my test)
<Snrrrub>
mfp, does this mean that there's no clean way of initializing a library implicitly on startup?
<mfp>
you can provide e.g. Mylib.Init.doinit : unit -> unit in a module that refers to all those you want to be initialized
<mfp>
don't know any cleaner way
<flux>
hm
<Snrrrub>
Yikes, that's rough. Thanks for the help.
<flux>
why not make the said module call Mylib.Init.doinit as the last thing it does?
<Snrrrub>
flux, the problem is that the toplevel doesn't run in the .cma
<bla>
You can call some init function each time you run module function and make it initialize things only once... (I know it's not ok also)
<bla>
Dynlink.loadfile says:
<bla>
All toplevel expressions in the loaded compilation units are evaluated.
<bla>
When using Dynlink.loadfile
<mfp>
Dynlink is more trouble than it's worth here
<Snrrrub>
Hmmm, I think the problem in my case is that all of the functions exposed by my library are C code with "external" in the module so referring to the external functions isn't sufficient
<bla>
Yes, I see it now.
<mfp>
(what's better 1 line with Mylib.Init.doinit () + Init defined in the lib or loads of Dynlink.loadfile in the client code?)
<mfp>
ah external changes everything if it's included in the signature
<Snrrrub>
So maybe I can make one of my functions non-native and still pass-through to native just so I get the toplevel running
<bla>
No, no. Dynlink is for sure not to be used; But I'm looking for some hints on how to force top-level execution.
<mfp>
Snrrrub: is external : ... exported in the signature? removing it will make the calls a bit slower but should initialize the module
<Snrrrub>
mfp, yes, that seems to be the problem (and fix).
<Snrrrub>
mfp, I'm curious: when the compiler is resolving dependencies, it would know that I'm referring to some code (albeit, "external") in another module so couldn't it run the toplevel? Or do you think this behaviour is by-design?
<bla>
#trace talk;;
bzzbzz has joined #ocaml
rwmjones has quit ["Closed connection"]
xavierbot has quit [Remote closed the connection]
middayc has joined #ocaml
OChameau has quit ["Leaving"]
zenhacker-rouan has quit [Remote closed the connection]
<bla>
Perl guys - we need to change m/^\s*([^\#].*;;)\s*$/ in line 121 to something like m/^\#\s*([^\#].*;;)\s*$/
<bla>
And then strip the first # from the line... before passing to ocaml. And that's the patch. But I can't do it.
ttamttam has joined #ocaml
<bla>
Or; use something more elaborate like TL> <ocaml code> ;; and pass to ocaml only such a fragment. Then one can use code inside of his sentence.
ita has joined #ocaml
jderque has quit ["leaving"]
mwc has joined #ocaml
ita has quit [Remote closed the connection]
jlouis has quit [Remote closed the connection]
jderque has joined #ocaml
jlouis has joined #ocaml
Yoric[DT] has quit [Remote closed the connection]
Yoric[DT] has joined #ocaml
ttamttam has left #ocaml []
eroyf has quit [Client Quit]
eroyf has joined #ocaml
<bla>
Note to rwmjones: If nick is changed help command should be changed also!
<mfp>
Snrrrub: if "external..." is exposed in the signature the compiler can generate direct calls to the C funcs; otherwise, they go through the slots created at module init time (hence forcing evaluation of other top-level expressions)
Snrrrub has quit ["Leaving"]
netx has quit ["Leaving"]
thelema has quit [Read error: 110 (Connection timed out)]
psnively has quit []
RobertFischer has joined #ocaml
|Catch22| has joined #ocaml
jderque has quit [Read error: 113 (No route to host)]
marmottine has quit ["Quitte"]
seafood_ has joined #ocaml
xaviertest has joined #ocaml
<bla>
Beginning of normal sentence ++ let a = Printf.printf "bleh";; let b = 3;; end of sentence.
<xaviertest>
blehval a : unit = ()
<bla>
++ b;;
<xaviertest>
Characters 2-3:
<xaviertest>
b;;
<xaviertest>
^
<xaviertest>
Unbound value b
<bla>
Hm. Almost works. :P
xaviertest has quit [Remote closed the connection]
<bluestorm>
hm
<bluestorm>
in the toplevel
<bluestorm>
# foo;; bar;; doesn't read the bar part
<bluestorm>
so your behaviour is coherent at least :p
<bla>
Huh. Your're right.
<bla>
Still there's one correction necessary.
xaviertest has joined #ocaml
<bla>
I've changed the code so it substitutes it's current nickname in output.
<bla>
xaviertest help
<xaviertest>
hello bla, I am xavierbot 0.9, an OCaml toplevel
<xaviertest>
++ expr ;; evaluate expr in toplevel and print result
<xaviertest>
help this help message
<xaviertest>
restart restart the toplevel
<xaviertest>
sleep go to sleep
<xaviertest>
wake wake me up from sleep
<bla>
(Excluding this bot name in help)
<bla>
xaviertest, sleep
<xaviertest>
xaviertest goes to sleep (do 'xaviertest wake' to wake)
<bla>
xaviertest, wake
<xaviertest>
xaviertest wakes up
<bla>
I'm doubful about using '#' as introduction to ocaml statement... But nevertheless it's possible. ++ "quite\n";; Is ++ ok?
<xaviertest>
- : string = "quite\n"
<bluestorm>
apart from being longer to type, what is the difference between ++ and # ?
<bla>
That there are ocaml top-level commands starting with #.
<bla>
Oh, there's some nickserv notice facility...
thermoplyae has joined #ocaml
<bla>
Duh, he haven't registered nickname.
thelema has joined #ocaml
<thelema>
bluestorm: recall that module we talked about yesterday? What about Typestruct for its name? Set.Make(Typestruct.Int)
<bluestorm>
hm
<bluestorm>
it doesn't strike me as an obvious name, but.. why not ?
<thelema>
ocamlc already has a source file types.ml, so I couldn't use that.
<bluestorm>
i see
ita has joined #ocaml
<bluestorm>
what is the defined purpose of that module actually ?
<bluestorm>
i thought it was just "providing OrderedType instances for basic types", but it seems to have evolved in something more organized
<thelema>
it slao includes NumericType instances for basic types
<thelema>
*also
<bluestorm>
do you plan to extend it further in the future ?
<thelema>
anything else you think it could use?
<bluestorm>
hm, i don't know :p
<thelema>
I've already made additions to Nativeint and Int64 to include modulo and pow
<thelema>
(although I think I may want 'mod' instead of 'modulo'
<bluestorm>
you mean, the root modules ?
<thelema>
yes.
<thelema>
why not?
<bluestorm>
i didn't use "mod" because it's an infix operator, wich had doubtful syntaxic problems in the past, but why not
<bluestorm>
hm
<bluestorm>
it's probably a good idea :p
<thelema>
good point - I'll keep it modulo, and hopefully we can get an infix mod sometime.
<bluestorm>
i was happy with the method of implementing in the numeric-specific declarations, because it didn't required change in the root modules, but if you can do that, why not ?
<thelema>
exactly what I thought.
bongy has joined #ocaml
<bluestorm>
thelema: a maybe-dubious choice of the numeric modules was to use the dotted infix notation : +. -. *., etc.
<thelema>
that's already pulled.
<bluestorm>
the main idea was to allow an homogenous syntaxic sugar for the numeric modules
<bluestorm>
wich i think is a good idea
<thelema>
no sugar in this, just a consistent interfact.
<thelema>
*interface
<bluestorm>
hm
<bluestorm>
i think the sugar has some value, still, has people tend to complain about the "lack of overloading of +" and so on
<bluestorm>
(and iirc there is sugar in the Num module)
<bluestorm>
s/has/as/
<bluestorm>
but we could still provide sugar as a separate functor, anyway
<bluestorm>
on the other hand, a good sugar choice needs a bit mor thought, so removing it may be a good idea in the first place
<thelema>
Sugar can come later.
<thelema>
agreed.
<bla>
Complainers might try F# also.
<bluestorm>
hm
schme has quit [Remote closed the connection]
<bla>
Is there normal mod function for ints?
Jedai has joined #ocaml
<bluestorm>
having kind of retarded "no doubtfully-patended MS platforms on my computer" opinions, i'm more interested in improving the practical sides of OCaml, though
<bluestorm>
bla: (mod) ?
<bla>
Hm, sure. But still there's some inconsistency.
<bla>
There's mod_float but no mod_int.
<bla>
let mod_int = (mod);; I guess. ;p
<bluestorm>
and (mod) doens't work well in camlp4 3.10.0
<bla>
When it comes to arithmetic ocaml becomes usually LISP.
netx has quit [Read error: 110 (Connection timed out)]
<thelema>
bla: not worse than (for example) C, no?
<bla>
I don't think it's very bad. It's just lispy. ;) ++ ((+) ((-) 10 3) (( * ) 5 30)) ;;
<xaviertest>
- : int = 157
<thelema>
(10-3)+(5*30);;
<bla>
I've read Stroustroup (or close) paper about overloading... WHITESPACE operator. So one can write 'a b c' meaning multiplication. And, 'abc' also. I guess it's much worse idea.
<thelema>
whitespace ain't an operator.
<bla>
For now, not. But in C++0x I'm not sure.
<bla>
Hopefully they won't do it.
xaviertest has quit [Remote closed the connection]
xaviertest has joined #ocaml
<bla>
# 2+2;;
<xaviertest>
- : int = 4
<bla>
# #load ;;
<xaviertest>
Wrong type of argument for directive `load'.
<bla>
Child said: Wrong type of argument for directive `load'.
<bla>
Sss.
xaviertest has quit [Remote closed the connection]
Jedai has quit [Read error: 104 (Connection reset by peer)]
<bla>
bluestorm, that's why i didn't like the idea. But there should be a method to do it.
<bluestorm>
hm
<bluestorm>
it's that way in the toplevel
<bluestorm>
but if you prefer something different, it's fine
<bla>
But I guess it shouldn't be allowed here.
<bla>
I mean # statements.
<bla>
It's much morenatural to start this with #, you're right.
<Yoric[DT]>
bla: scary.
<mwc>
bla, hahaha, what? juxtaposition operator?
xaviertest has joined #ocaml
<bla>
Pity I haven't got this paper. :)
<bla>
Test # let a = 2 + 2 in a + 3;;
<xaviertest>
- : int = 7
<bla>
# #load "test";;
<xaviertest>
Characters 1-5:
<xaviertest>
load "test";;
<xaviertest>
^^^^
<xaviertest>
Unbound value load
<bla>
Ok.
<bla>
# # # # # 3;;
<xaviertest>
- : int = 3
<bla>
bluestorm, ok? :)
<bluestorm>
hm
<bluestorm>
that's fine :p
<mfp>
# let a = object method foo = 1 end;;
<xaviertest>
val a : < foo : int > = <obj>
<mfp>
# a#foo;;
<xaviertest>
- : int = 1
RobertFischer has left #ocaml []
<bla>
Only the first # is stripped.
rwmjones has joined #ocaml
<bla>
rwmjones, got mail/
<rwmjones>
yes, later though
rwmjones has quit [Client Quit]
<bla>
# let people = ["wmc"; "Yoric"; "bluestorm"] in let bye x = Printf.printf "%s: bye, bye.\n" x in List.iter bye people;;
<xaviertest>
wmc: bye, bye.
<xaviertest>
Yoric: bye, bye.
<xaviertest>
bluestorm: bye, bye.
<xaviertest>
- : unit = ()
xaviertest has quit [Remote closed the connection]
bongy has quit ["Leaving"]
mbishop has quit [calvino.freenode.net irc.freenode.net]
tsuyoshi has quit [calvino.freenode.net irc.freenode.net]
acatout has quit [calvino.freenode.net irc.freenode.net]
mbishop has joined #ocaml
acatout has joined #ocaml
tsuyoshi has joined #ocaml
ita has quit [calvino.freenode.net irc.freenode.net]
mwc has quit [calvino.freenode.net irc.freenode.net]
middayc_ has quit [calvino.freenode.net irc.freenode.net]
postalchris has quit [calvino.freenode.net irc.freenode.net]
mattam has quit [calvino.freenode.net irc.freenode.net]
bluestorm has quit [calvino.freenode.net irc.freenode.net]
pattern has quit [calvino.freenode.net irc.freenode.net]
__suri has quit [calvino.freenode.net irc.freenode.net]
petchema has quit [calvino.freenode.net irc.freenode.net]
svenl has quit [calvino.freenode.net irc.freenode.net]
TaXules has quit [calvino.freenode.net irc.freenode.net]
gaja has quit [calvino.freenode.net irc.freenode.net]
kig has quit [calvino.freenode.net irc.freenode.net]
unfo- has quit [calvino.freenode.net irc.freenode.net]
jdavis_ has quit [calvino.freenode.net irc.freenode.net]
ikatz has quit [calvino.freenode.net irc.freenode.net]
nasloc__ has quit [calvino.freenode.net irc.freenode.net]
Smerdyakov has quit [calvino.freenode.net irc.freenode.net]
jeremiah has quit [calvino.freenode.net irc.freenode.net]
hcarty has quit [Remote closed the connection]
hcarty has joined #ocaml
rogo has joined #ocaml
ita has joined #ocaml
mwc has joined #ocaml
middayc_ has joined #ocaml
postalchris has joined #ocaml
mattam has joined #ocaml
bluestorm has joined #ocaml
pattern has joined #ocaml
__suri has joined #ocaml
petchema has joined #ocaml
svenl has joined #ocaml
TaXules has joined #ocaml
gaja has joined #ocaml
kig has joined #ocaml
ikatz has joined #ocaml
jeremiah has joined #ocaml
Smerdyakov has joined #ocaml
nasloc__ has joined #ocaml
jdavis_ has joined #ocaml
unfo- has joined #ocaml
|Catch22| has quit [calvino.freenode.net irc.freenode.net]
shortcircuit has quit [calvino.freenode.net irc.freenode.net]
|Catch22| has joined #ocaml
shortcircuit has joined #ocaml
tsuyoshi has quit [calvino.freenode.net irc.freenode.net]
mbishop has quit [calvino.freenode.net irc.freenode.net]
acatout has quit [calvino.freenode.net irc.freenode.net]
mbishop has joined #ocaml
acatout has joined #ocaml
tsuyoshi has joined #ocaml
Tetsuo has quit ["Leaving"]
tsuyoshi has quit [Connection timed out]
Yoric[DT] has quit ["Ex-Chat"]
seafood_ has quit []
Snrrrub has joined #ocaml
<Snrrrub>
if I have a variant type and I want to expose it (the type and all its possible values), do I have to copy the definition of the type or is there a way I can just specify it in one location?
middayc_ has quit [Connection timed out]
middayc has quit []
middayc has joined #ocaml
<thelema>
Snrrrub: put it in the module's .mli file.
<thelema>
the full definition
* bla
is just trying to compile it without placing it also in .ml file.
<thelema>
the only way to specify the type only once involves forgoing the .mli file and letting the compiler generate the .cmi directly from the .ml
<Snrrrub>
thelema, do I need to qualify the use of the types with the module name then? Because I get an "unbounded constructor" error if I only have it in the .mli
<Snrrrub>
ah, that's sad :(
<thelema>
I misunderstood your question at first.
<Snrrrub>
or rather, makes me sad.
<Snrrrub>
I wasn't particularly clear myself.
<bla>
However you will get following if they don't match:
<bla>
The implementation test.ml does not match the interface test.cmi:
<bla>
The field `numbers' is required but not provided
<bla>
Or, wrong.
<bla>
The implementation test.ml does not match the interface test.cmi:
<bla>
The field `numbers' is required but not provided
<bla>
Sorry; I guess it sucks somehow.
<bla>
:)
<Snrrrub>
If they're enforcing consistency, why wouldn't they just use what's specified in the interface? Or are there bigger issues at play that I don't understand yet?
<bla>
Type declarations do not match:
<bla>
Yeah, got it. Enforced.
<thelema>
.mli files don't get included in .ml files like .h -> .c in C
<bla>
And you can possibly not export this type, or export is as an abstract type.
<thelema>
module A: sig (* contents of file A.mli *) end
<thelema>
= struct (* contents of file A.ml *) end;;
<Snrrrub>
thelema, exactly - they're both part of the same containing construct so even though it's not a simple lexical inclusion, they'd both have to be parsed and cross-referenced (e.g. to check consistency)
<thelema>
ocaml strictly separates sig metadata from struct data. How would you propose they mix?
<thelema>
you'd like any types (any maybe module types) defined in a .mli file to automatically become usable from the corresponding .ml file?
<Snrrrub>
thelema, that's right
* thelema
puts that on his TODO list
<Snrrrub>
because both the .ml and .mli are defining the same module (different aspects, sure, but together they form a whole)
<thelema>
the .ml is the whole. the .mli specifies the interface to that whole.
<bla>
It could cause .ml to be unusable without .mli file
<bla>
which currently is not the case.
<bla>
I guess the interface currently can only be wider than proposed by .mli.
<bla>
Not sure if it's worth it just.
<Snrrrub>
bla, the .mli is implied if it's not found so in my head, you still have an interface for any module
<bla>
No if it will held types which .ml uses.
bluestorm has quit ["Konversation terminated!"]
<Snrrrub>
Sorry, I didn't follow that last statement...
<thelema>
Snrrrub: yup. so just don't write .mli files.
<thelema>
Snrrrub: if you pull types from a .mli into the .ml, the .mli won't be impliable.
<bla>
I mean if you would place types ONLY in .mli file as you propose then file .ml itself would be unusable. While currently you can always generate .mli from .ml.
<bla>
I guess convenience is not worth it. ;)
<Snrrrub>
bla, I'm not suggesting that you always put all types in .mli files. Rather, I'm putting forth the idea that types that need to be exposed should be in the .mli file and types that should not be exposed should be in the .ml (and if the .mli is not present, all types in the .ml are exposed as it happens right now)
<thelema>
bla: if done correctly, there's no problem.
<bla>
Snrrrub, but still it's a case to be handled. Compiling .ml file would involve using compiled .mli file and so on.
<bla>
thelema, yeah, it can be done.
<thelema>
compiling a .ml file *does* involve the .cmi
<bla>
True; but in a less "involving" manner. :D
<bla>
You lose independency of .ml and .mli file but you gain convenience and you do not repeat the same code.
<thelema>
C programmers don't seem to suffer much harm having types declared in .h files, upon which their .c files depend.
hsuh has joined #ocaml
<bla>
True.
seafood_ has joined #ocaml
Snrrrub__ has joined #ocaml
jlouis_ has joined #ocaml
<mfp>
Snrrrub: you could use some hack involving Camlp4MacroParser
bla has quit [Nick collision from services.]
bla has joined #ocaml
<mfp>
foo.mli: type t = Foo | Bar IFNDEF IMPL THEN val foo : int ENDIF foo.ml: DEFINE IMPL INCLUDE "foo.mli" let foo = 1
<mfp>
this should work, will require -pp "camlp4o -parser Camlp4MacroParser"
<thelema>
mfp: can't include foo.mli like that - "val xxx" definitions aren't allowed in foo.ml
<thelema>
impl...
<mfp>
that's what the IFNDEF is for
<thelema>
n/m
<thelema>
hmm...
<thelema>
any way to have p4 automatically filter out all vals?
<mfp>
use some pa_filterbla that ignores str_items
<mfp>
Camlp4MacroParser doesn't like that Parse error: [smlist] expected after "THEN" (in [macro_def])
<mfp>
it wants str_items since it's not in sig context it seems
jlouis has quit [Read error: 110 (Connection timed out)]
<mfp>
oh well, then #define and #ifndef, -pp cpp :-P
nameless` has joined #ocaml
<nameless`>
hi
Snrrrub has quit [Read error: 110 (Connection timed out)]