<CosmicRay>
just know that haskell lists are designed with infinite situations in mind
<CosmicRay>
ocaml's aren't
<CosmicRay>
I'm not surprised that haskell is faster in those situations, and ocaml is faster for finite lists
<CosmicRay>
also note how simpler the haskell source is for that algorithm :-)
<CosmicRay>
the ocaml source could have been easier if they had used streams and camlp4
<ianxek>
Yes, the Haskell code is very nice there...
velco has quit ["Client exiting"]
Herrchen has quit ["bye"]
tnks has left #ocaml []
mrsolo has quit [Read error: 110 (Connection timed out)]
<mrvn_>
ianxek: 2a1 or 2a2?
monochrom has joined #ocaml
<mrvn_>
New topic: I'm using the Unix.socket and Unix.bind but after my program quits the port stays blocked for a minute. How can I tell the system to free it emidiatly?
<vincenz>
Is it possible to do mixins with ocaml
<vincenz>
?
<ianxek>
mrvn : My question was about 2A1, and it's also the one which looks good in haskell
<mrvn_>
vincenz: mixins?
<vincenz>
classes who
<vincenz>
classes who's superclass can be changed (at designtime, not runtime)
<vincenz>
c++ style:
<vincenz>
template <class Super> class X : public Super {}
<vincenz>
aaka is it possible to make the inherit xxx inside a class changeable
<vincenz>
(chosen at compiletime of course)
<mrvn_>
That would be a functor.
<vincenz>
a classfunctor?!?
<mrvn_>
module Make:
<mrvn_>
functor (Ord : OrderedType) -> S with type elt = Ord.t
<vincenz>
I'm talking about classes
<vincenz>
for example
<mrvn_>
A functor should be able to return a class.
<vincenz>
oh
<vincenz>
and the OrderedType can be a class?
<vincenz>
class-type..
<mrvn_>
Or a module that contains the class to be precise.
<vincenz>
hmm
<vincenz>
thnx!
<vincenz>
so I could do
<monochrom>
mrvn_: Unix.close
<mrvn_>
monochrom: No. that keeps the port locked down for another minute.
<monochrom>
If that doesn't work, I don't know.
<vincenz>
functor (T : BasicClassType = struct class object inherit T as super ....
<vincenz>
monochrom: the fact that your port doesn't close until a minute later is most likely OS-dependent
<Smerdyakov>
vincenz, "inherit" never matters for typing purposes.
<Smerdyakov>
vincenz, it's like #include.
<mrvn_>
It is a security feature so that a evil program can't take over the port directly and pretend to be the old server.
<vincenz>
Smerdyakov: so potentially it could be passed as a parameter during construction?
<monochrom>
Hrm Unix.shutdown is the next candidate.
<Smerdyakov>
vincenz, or did you just forget a ) in your code?
<vincenz>
and you coudl do it without a functor
<vincenz>
forget a ) ?!?
<Smerdyakov>
<vincenz> functor (T : BasicClassType = struct class object inherit T as super ....
<mrvn_>
vincenz: you can pass a struct of functions instead of using a functor.
<Smerdyakov>
Should i have been:
<vincenz>
oh yes
<vincenz>
add ) after BasicClassType
<vincenz>
but that was just what I typed here, not real code
<Smerdyakov>
I don't know.
<Smerdyakov>
I never use the OO features, and I don't know why you want to.
<vincenz>
polymorphism
<monochrom>
Actually I don't see how the security feature gives security.
<mrvn_>
vincenz: you can probably also do some "class 'a Foo" magic.
<Smerdyakov>
You shouldn't use "polymorphism" to mean that in this channel.
<Smerdyakov>
Say "dynamic dispatch" instead.
<vincenz>
basically I have my main program instantiate a state-machine that does processing
<vincenz>
different option to the program, differetn statemachine
<mrvn_>
monochrom: If you have a client/server programm that uses a random port an attacker could kill the server and bind the port before the client is fully started and similar.
<vincenz>
some processing can be reused so I was thinking of using mixins to combine different functionalities into one statemachine
* Demitar
ponders what program to use to generate C interfacing code...
<monochrom>
is the attacker on the server?
<vincenz>
passing it as param is apparently not possible, so going for the next try: parametrized clases
<mrvn_>
monochrom: has to be or he couldn#t bind.
<vincenz>
nope
<monochrom>
Then the attacker could do a lot of worse things than that.
<mrvn_>
vincenz: class Foo funcs = ...?
<vincenz>
mrvn_: whatever for?
<monochrom>
So my feeling is it's rather useless because the scenerio is unlikely to be isolated. If the scenerio happens, a lot of worse things have already happened too, and the point is moot.
<mrvn_>
vincenz: funcs is your function dispatch table setup by the main function.
<vincenz>
mrvn_: not good enough
<vincenz>
the real power of mixins is chaining
<Demitar>
mrvn_, you do know to reuse the socket, right? (Or perhaps that's not what you're asking. Besides I doubt you can really reuse the actual connections when the process has stopped.)
<mrvn_>
monochrom: It is an very old feature present in pretty much all unixes I think.
<mrvn_>
Demitar: Yes, I want to reuse the socket.
<monochrom>
I recall experiencing in some unixes but not all.
<mrvn_>
Demitar: I hate waiting a minute between test runs.
<Demitar>
Unix.SO_REUSESOCKET
<monochrom>
Perhaps that means on some unixes SO_REUSESOCKET is the default.
<Demitar>
REUSEADDR even.
<vincenz>
how do you make an object signature?
<monochrom>
Yeah we know you mean that. :)
<vincenz>
class type x = ..
<vincenz>
got it
<vincenz>
no need for virtual
<mrvn_>
Demitar: thanks. That's it.
<mrvn_>
class type raw_io = object
<mrvn_>
val file_descr : Unix.file_descr
<mrvn_>
method on_error : unit
<mrvn_>
end
<mrvn_>
method write : (string -> int -> int -> int)
<Demitar>
Can you really inherit a class /type/? You can implement the interface but there's nothing to inherit from (a virtual class you could inherit from). Or am I merely confused?
<vincenz>
I am not inheriting a class type
<vincenz>
I'm inheriting a class of that type
<vincenz>
note it's S
<vincenz>
I mean Y
<vincenz>
S is is the signature
<Demitar>
Yes, but it's still a class type. (Rather than a signature of a class type.)
<vincenz>
oh!
<vincenz>
is it?
<mrvn_>
Demitar: Shouldn#t the functor part take care of that?
<Demitar>
I'm quite unreliable right now so I'd better be silent. :)
<mrvn_>
vincenz: Do you only want to use "super#test" or do you actually want to inherit some functions?
<mrvn_>
you need 'class mach(self) : .... (self:>Y)#test;;
<vincenz>
mrvn_: why?
<mrvn_>
vincenz: because as seems to be not allowed
<vincenz>
mrvn_: it works :)
<vincenz>
I don't need self:>Y.machine
<vincenz>
I inherit as super
<vincenz>
Woot :)
<vincenz>
It works
<vincenz>
module A = struct class machine = object method test = Printf.print "Top\n" end end
<vincenz>
module Y = X(A);;
<mrvn_>
Wait, what did you change in the two paste buffers?
<vincenz>
module Z = Y(X(A));;
<vincenz>
mrvn_: I wnet from class type to class :
<vincenz>
that should be Z = X(Y);;
<mrvn_>
vincenz: fine
<vincenz>
:D
<vincenz>
woot!
<vincenz>
mixins here I come
<mrvn_>
I have a bunch of lines in the form: Scanf.sscanf line "arch: %s"
<mrvn_>
Can I make the 'arch' into a variable somehow?
<vincenz>
can you have functor directly inside an .ml file so that .ml filename is the name of the functor?
<vincenz>
mrvn_: as long as it doesn't contain spaces, yes
<vincenz>
Scanf.sscanf "%s: %s"
<mrvn_>
vincenz: Then it doesn't match.
<vincenz>
use regexp (Str.module)
<Smerdyakov>
mrvn_, what doesn't match?
<mrvn_>
"arch: %s" only read in 'arch: something' but not 'foo: bar'
<vincenz>
mrvn_: use regexp
<Smerdyakov>
But what about "%s: %s"?
<vincenz>
doesn't %s: %s imply that sscanf canbacktrack?
<Smerdyakov>
No.
<mrvn_>
%s: will never work because the %s eats the :
<vincenz>
yes
<Smerdyakov>
mrvn_, "%[^:]: %s", then
<mrvn_>
scanf can do that?
<Smerdyakov>
Yes
<vincenz>
nice
<vincenz>
if I put functor (X: S) -> as first line inside x.ml will X be a functor-module then?
<vincenz>
or is that not possible?
<vincenz>
(I don't want the extra Make)
<Smerdyakov>
vincenz, not possible
<vincenz>
:/
<vincenz>
pity
<mrvn_>
So I need a Scanf.scanf "%[^:]: %s" (fun x y -> if x = "arch" ...)
<mrvn_>
Can I tell scanf to read until a newline that is not followed by a space but not include the non-space char?
<vincenz>
doesn't scanf stop at newline anyways?
<mrvn_>
l: applies f to the number of lines read so far.
<mrvn_>
doesn't look that way.
velco has joined #ocaml
<mrvn_>
hah, %c: reads a single character. To test the current input character without reading it, specify a null field width, i.e. use specification %0c. Raise Invalid_argument, if the field width specification is greater than 1.
* vincenz
palmslsaps
<vincenz>
this is really regexp work
<vincenz>
you're abusing scanf
<mrvn_>
yeah. Just out of intrest.
<vincenz>
and obviously, scanf can backtrack or it wouldn't be able to do these things
<vincenz>
mrvn_: also
<vincenz>
use s@:
<vincenz>
use %s@:
<mrvn_>
C can backtrack one char (unput(char)) but not more.
<vincenz>
mrvn_: it's only for c tho
<vincenz>
not for ranges
<mrvn_>
"%s@:%s@\n" looks like what I need for simple lines.
<Smerdyakov>
vincenz, I don't agree that "obviously, scanf can backtrack."
<vincenz>
well if you can do things like %0c..
<vincenz>
it has to backtrack one read-character
<mrvn_>
$0c just needs a one char lookahead.
<Smerdyakov>
I don't call that "back-tracking."
<vincenz>
then don't call that backtracking, that's what I meant
<vincenz>
question: how do you define val's in class x :
<async>
what's the best way to make a string parsing rule in ocamllex?
<async>
'"' + [^ "] + '"' is one way, but it seems like a hack
<async>
and it gets the longest possible string it can
<karryall>
and it doesn't work if you want \" escapes
<async>
yeah
rossberg has quit ["Leaving"]
<karryall>
just use another entry point
rossberg has joined #ocaml
<karryall>
and string b = parse
<karryall>
| '"' { Buffer.contents b }
<karryall>
| "\\\"" { Buffer.add_char b '"' ; string b lexbuf }
<karryall>
| _ { Buffer.add_char b (Lexing.lexeme_char lexbuf 0) ;
<karryall>
string b lexbuf }
<karryall>
something like that
<async>
how does the lexer know what entry point to use?
<mrvn_>
define it recursive.
<karryall>
?
<mrvn_>
async: the first entry point calls the second if it finds a "
<async>
ah, ok
<karryall>
yes
<async>
wow
<mrvn_>
for nested comments use the same
<karryall>
| '"' { let s = string (Buffer.create 64) in ... }
<karryall>
forgot the lexbuf arg
<async>
so in general you should only write one parser?
<karryall>
er we're talking about lexers here
<async>
yeah
<async>
nvm
<async>
thanks a lot
<async>
karryall: i also didn't know you could use 'Buffer' like that, very interesting
<async>
and have arguments to lexer rules
<karryall>
that's since 3.07 I think
<karryall>
otherwise you'd have to use a buffer in a global variable
<mrvn_>
karryall: But then you have to be carefull with nested comments.
<karryall>
indeed
Niccolo has left #ocaml []
monochrom has quit ["Don't talk to those who talk to themselves."]
pango has quit ["Leaving"]
pango has joined #ocaml
<mrvn_>
How do I write a method for an object to remove itself from a global list?
<mrvn_>
connects := List.filter (fun x -> not (x = self)) !connects
<mrvn_>
Self type cannot escape its class
<mrvn_>
make: *** [wanna-build.cmx] Error 2
<mrvn_>
never mind
velco_ has joined #ocaml
velco has quit [No route to host]
velco_ is now known as velco
Submarine has joined #ocaml
hukhuk has joined #ocaml
<vincenz>
Odd
<vincenz>
I have a mli
<vincenz>
compiled into a .cmi
<vincenz>
fliename is stateMachine.cmi
<vincenz>
I have another .ml file that hasa functor(Super : StateMachine)
<vincenz>
I try to compile and it complains there's no module type StateMachine
<haakonn_>
i wonder if modules can be named like that. i always see them on the form "State_machine".
<Submarine>
that's normal AFAIK
<vincenz>
so why the compile error?
<Submarine>
just put your module type into a .ml
<Submarine>
.mli files are not freestanding module types
<vincenz>
it's only a signature
<Submarine>
they are module types used to restrict a module given in a .ml
<vincenz>
I only need it as module-type
<Submarine>
therefore put it inside a .ml with a module type FOO = sig ... end construct
<vincenz>
oh!
<vincenz>
but then it will be StateMachine.FOO
<vincenz>
okok
<mrvn_>
Put it into the ml file of the functor.
<mrvn_>
like Set.OrderedType
<vincenz>
yeah
<vincenz>
:)
<vincenz>
Does calling methods add a lot of overhead or can they be in lined?
<vincenz>
super#method..
<Demitar>
Optimizing too early already?
<mrvn_>
It has to lookup the method in the function table of the class to allow for overloading. At least with virtual functions.
<mrvn_>
But I think ocaml always does no matter what.
<vincenz>
yes but...
<vincenz>
calling super...
<vincenz>
you know which your superclass is at compiletime
<vincenz>
so..
<vincenz>
it should be able to inline it, no?
<mrvn_>
if super#method is virtual that can be anything
<Demitar>
I think very little is inlined overall. It could, but it doesn't.
<vincenz>
mrvn_: well it's not virtual (and virtual actually means abstract, not virtual in the C++ sense, as all methosd are virutal)
<vincenz>
but... once you're inside a class the real method called should be computable no?
<Demitar>
And in general those optimizations you think you need you really don't.
<vincenz>
it should be inlinieable
<vincenz>
Demitar: trust me, for mixins you do
<mrvn_>
vincenz: as I said, afaik ocaml doesn't do any of those.
<vincenz>
ok, thxn
<vincenz>
damn
<Demitar>
Of course, I generally distrust classes. :)
<vincenz>
another issue
<vincenz>
if I define the types of parameters in the mli
<vincenz>
(to a method)
<vincenz>
but I dont' deifne them in the .ml
<vincenz>
I just have _
<vincenz>
why do I need to define the type again?
<vincenz>
it complains about unbound types
<Submarine>
all types in .mli have to be defined in .ml
<vincenz>
I mean
<vincenz>
mli:
<vincenz>
method process_all_access :
<vincenz>
(* address, poolid, varid, scopeid *)
<vincenz>
Address.t -> Id.t -> Id.t -> Id.t -> unit
<vincenz>
ml
<vincenz>
method process_all_access _ _ _ _ =
<vincenz>
()
karryall has quit [Read error: 104 (Connection reset by peer)]
velco has quit ["I'm outta here ..."]
Submarine has quit ["ChatZilla 0.8.31 [Mozilla rv:1.4.1/20031114]"]
<pango>
vincenz: I guess you have some free type in class definition, that you haven't declared as a class parameter
<pango>
# class blah =
<pango>
object
<pango>
method add x = x
<pango>
end ;;
<pango>
Some type variables are unbound in this type:
<pango>
class blah : object method add : 'a -> 'a end
<pango>
The method add has type 'a -> 'a where 'a is unbound
<pango>
# class ['a] blah =
<pango>
object
<pango>
method add (x:'a) = x
<pango>
end ;;
<pango>
class ['a] blah : object method add : 'a -> 'a end
<vincenz>
yaeh I figured it out:)
<vincenz>
ok
<vincenz>
file.mli: module type Mixin = sig ..end
<vincenz>
file.ml : module Mixin = struct end
<vincenz>
won't match
<vincenz>
nm
<vincenz>
got it
monochrom has joined #ocaml
* vincenz
mutters
<vincenz>
hmm
<vincenz>
if I use modules instead of classes it will inline, right?
<pango>
for functions smaller than some size, based on ocamlopt -inline threshold...
<vincenz>
alrightio
<vincenz>
then I might have to switch to modules I mean
<vincenz>
module A = AccessesMachine.Mixin(StateMachine.Machine)
<vincenz>
module B = BlocksMachine.Mixin(A)
<vincenz>
module C = ScopesMachine.Mixin(B)
<vincenz>
module Machine = C
<vincenz>
let machine = new Machine.machine function_map in
<vincenz>
:P
<vincenz>
except that with modules I'd have to define every function in every mixin even if it doesn't do anything extra
* vincenz
goes to rip up his old classes to have more mixins (separating functionality is good)
<Smerdyakov>
When you finally get the idea of functors into your head, you will see that mixins are a rather limited special case.
<vincenz>
yeah I know
<vincenz>
the thing is
<vincenz>
at the bottom
<vincenz>
my bottom macihne takes in packet
<vincenz>
sets up an environment
<vincenz>
and then calls self#(functions that mixins do)
<vincenz>
I know it can be transformed but I'll do that later if necessary
<mrvn_>
vincenz: functors can't inline. The code generated for the functor doesn't know anything about the actual modules you later use to call it.
<Smerdyakov>
Functors are inlined in MLton. Maybe the OCaml compiler isn't cool enough. :P
<mrvn_>
You can't inline across compilation units.
<Smerdyakov>
You can with MLton.
<mrvn_>
Smerdyakov: how? you don't have the source to inline it.
<Smerdyakov>
MLton is a whole program compiler. It's easy to imagine inlining a functor body given just an intermediate-code or even object-code form of it.
<mrvn_>
So you only have one compilation unit?
<Smerdyakov>
Yes. The second sentence in my last line works with as many compilation units as you want.
<vincenz>
it'd be nice to have that option (don't care about externals)
<mrvn_>
vincenz: I nearly always have multiple .ml files.
<Smerdyakov>
mrvn_, I hope you agree that separate compilation in no way inhibits inlining....
<vincenz>
yes but if you want to generate a program, not a lib, you can do optimization at the end
<mrvn_>
Smerdyakov: compiling to binary makes inlining very hard.
<mrvn_>
Smerdyakov: You would have to inline at link time.
<Smerdyakov>
mrvn_, you don't do that. You compile to a nicer intermediate language. Not doing so could be a flaw with the OCaml implementation, but it's not fundamental.
<mrvn_>
Well, you could compile to bytecode, link that into one big bytecode and then compile to binary.
<vincenz>
yeah
hukhuk has left #ocaml []
pharx has joined #ocaml
CosmicRay has quit ["Client exiting"]
<mrvn_>
How do I copy a record into another + some changes?
<mrvn_>
something like '{ using old_record; foo=17; }
<Smerdyakov>
{ old_record with foo = 17 }
<mrvn_>
thx
pflanze has quit ["[x]chat"]
<pharx>
what's the best way to represent large natural numbers? Nat, Big
<pharx>
_int, or something else?
<ianxek>
I use the num.mli, is there something better ?
<vincenz>
how do I do something like
<vincenz>
let (a, b, c, d, e) = some_func... in
<vincenz>
some_other_func (a+1,b,c,d,e)
<Smerdyakov>
vincenz, I don't see a reason why that wouldn't work, though of course it depends on what you include for the "..."!
<vincenz>
I want it cheaper (code-wise)
<Smerdyakov>
Then use records. There is no shortcut notation for tuples.
<vincenz>
true
<vincenz>
good idea
<vincenz>
it's too bad you cant' have multiple functor applications in one line
<vincenz>
you need to do
<vincenz>
module A = x.Make(Some)
<vincenz>
module B = Y.Make(A)
<vincenz>
...
<mattam>
you can
<vincenz>
odd, I tried to no avail
<mattam>
module B = Y.Make(x.Make(Some))
<vincenz>
hmm
<mattam>
X.Make actually, x is not allowed as a module name