monochrom has quit ["Don't talk to those who talk to themselves."]
cjohnson has quit ["The main attraction: distraction"]
goooomba has joined #ocaml
goomba has quit [Read error: 110 (Connection timed out)]
mrsolo has quit [Read error: 104 (Connection reset by peer)]
segphault has joined #ocaml
<segphault>
question: I want to define two separate classes, and make both classes have methods that return instances of the other class. Is this possible in ocaml?
<kinners>
segphault: sure, class name = object method new_name2 = new name2 end and name2 = etc.
<segphault>
I had tried using 'and', but I had done 'and class blah ='
ianxek has quit ["Leaving"]
segphault has quit [Read error: 110 (Connection timed out)]
mrsolo has joined #ocaml
Loopus has joined #ocaml
tautologico has quit []
zigong has joined #ocaml
lus|wazz has quit ["None of you understand. I'm not locked up in here with you. YOU are locked up in here with ME!"]
kinners has quit [Read error: 110 (Connection timed out)]
zigong has quit ["Leaving"]
CosmicRay has quit [Read error: 113 (No route to host)]
nrb23 has quit []
Kevin has joined #ocaml
Nutssh has joined #ocaml
_fab has quit [Remote closed the connection]
_fab has joined #ocaml
Herrchen has joined #ocaml
velco has joined #ocaml
Submarine has joined #ocaml
velco has quit ["I'm outta here ..."]
Lemmih has joined #ocaml
childe has joined #ocaml
<childe>
Hello world.
<childe>
Is there a ABI specification for Ocaml?
<Submarine>
indeed, look in "how to interface C with objective caml"
<childe>
Then how about the structure of the classes in Ocaml?
<Submarine>
ouch
<childe>
I want to know more exactly what the compiler produced
<childe>
:(
<Submarine>
mmmh... does this section talk about objects?
<childe>
Let me check it...
* Submarine
hardly ever uses objects in ocaml
<childe>
So, a function in Ocaml is just like a function in C when compiled to binary?
clog has quit [^C]
clog has joined #ocaml
<Submarine>
when compiled using ocamlopt, somewhat
<Submarine>
a caml function is a code block and a "closure"
<childe>
so the closure has a presentation in binaries
<Submarine>
the code block, depending on whether ocamlc or ocamlopt is used, is either bytecode, either binary code
<Submarine>
the compiler avoids creating unnecessary closures and tries to use as much as possible direct branches to procedures
<childe>
OK
childe has left #ocaml []
vezenchio has joined #ocaml
menace has joined #ocaml
GreyLensman has joined #ocaml
Kevin has quit [Nick collision from services.]
Kevin_ has joined #ocaml
smartie has joined #ocaml
mrsolo has quit [Read error: 110 (Connection timed out)]
gpciceri has joined #ocaml
menace has quit [Read error: 110 (Connection timed out)]
pango has joined #ocaml
Lemmih is now known as WilliamG
WilliamG is now known as Lemmih
pango_ has quit [Read error: 104 (Connection reset by peer)]
smartie has quit []
gpciceri has quit ["Ciao, sono un virus dei messaggi di quit. Sostituisci la tua vecchia linea di quit con questa cosi potro continuare a moltipl]
mrsolo has joined #ocaml
monochrom has joined #ocaml
pango has quit [Nick collision from services.]
pango_ has joined #ocaml
async has quit [Remote closed the connection]
menace has joined #ocaml
docelic has joined #ocaml
async has joined #ocaml
velco has joined #ocaml
ianxek has joined #ocaml
velco has quit ["I'm outta here ..."]
menace has quit []
karryall_ has quit [Read error: 104 (Connection reset by peer)]
GreyLensman has quit ["Leaving"]
Herrchen has quit ["bye"]
jurjen has joined #ocaml
velco has joined #ocaml
jurjen has quit ["Leaving"]
velco has quit ["I'm outta here ..."]
budjet has joined #ocaml
buddjett has joined #ocaml
buddjett has quit [Remote closed the connection]
<pharx>
how would i use Map with keys of type IntMap?
<Nutssh>
Apply the functor Map.Make(Intmap) (which assumes that Intmap matches module signature Map.S)
budjet has quit [Read error: 110 (Connection timed out)]
<pharx>
i tried that, it doesn't match
<Kevin_>
What is the error message?
<pharx>
signature mismatch: Modules do not match:
<pharx>
sig
<pharx>
type key = int
<pharx>
type 'a t = 'a IntMap.t
<pharx>
...
<pharx>
val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
<pharx>
val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
<pharx>
is not included in Map.OrderedType
<Kevin_>
The type for compare must be : "val compare : t -> t -> int"
<Kevin_>
The type "val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int" is the type for the 'result' module.
<pharx>
hm, ok
<Smerdyakov>
Nutssh, you said that Map.Make(Intmap) would work if Intmap has signature Map.S. In fact, obviously Intmap must have signature Map.OrderedType.
<Kevin_>
yep
<Smerdyakov>
pharx, this should not be confusing at all.
<pharx>
i see why it doesn't work, i don't see how to make work
<Smerdyakov>
pharx, Map.Make expects a structure with signature Map.OrderedType, and you are not giving it one.
<Smerdyakov>
pharx, you will have to create a _new_ module just to pass as the Map.Make parameter.
<pharx>
er, ok. i think i've got it now. thanks
<mrvn_>
Too bad modules don't have a "is_a" hierachy like classes.
<Smerdyakov>
mrvn_, they certainly do.
<mrvn_>
How do you inherit another modules signature?
<Kevin_>
include ?
<Smerdyakov>
You don't need to, just like you need nothing explicit to "inherit a class' type."
<Smerdyakov>
All subtyping is done by syntactic compatibility of members.
<mrvn_>
So if IntMap includes an x: OrderedType then the functor would work?
<Submarine>
if IntMap declares a type t and a compare function: t -> t -> int then it's an OrderedType
<Smerdyakov>
If IntMap were an implementation of OrderedType, then it would work.
<mrvn_>
Smerdyakov: Can one make a list of OrderedType?
<Submarine>
you can make a list of OrderedType.t
<Smerdyakov>
mrsolo, that doesn't make sense.
<Smerdyakov>
er, mrvn_, "
<Smerdyakov>
mrvn_, lists are a type-level idea, and we are talking about modules here.
<Kevin_>
Smerdyakov, that make sense but not in caml.
<mrvn_>
What I mean is have a bunch of modules that implement OrderedType and instances from all of them into one list.
<Kevin_>
only in a upper level langage that generate caml files
<Smerdyakov>
mrvn_, no.
<Smerdyakov>
Kevin_, what doesn't make sense in Caml?
<Kevin_>
because module are 'static' structures
<Smerdyakov>
Kevin_, you're saying that what mrvn_ asked for doesn't make sense in Caml, but does in other settings?
<Kevin_>
yep
<mrvn_>
You can easily do it with classes in ocaml. Just use [(x:>base_class)]
<Smerdyakov>
mrsolo, that's fine, but this is not something that is very useful for modules in practice.
<Smerdyakov>
mrvn_, "
<Smerdyakov>
Truly, if you want such features, you use OO.
<mrvn_>
Thats also what I meant with "inheriting" an interface.
<Smerdyakov>
You were imprecise. You should have specified that you were interested in dynamic dispatch.
<Kevin_>
mrvn_, I don't remember that this kinf of conversion is allow for modules types...
<Kevin_>
kinf -> kind
<Smerdyakov>
For instance, say we defined: module type Stupid = struct type t end
<mrvn_>
Kevin_: the [(x:>base_class)] is only for classes
<Smerdyakov>
Every OrderedType is also a Stupid.
<Smerdyakov>
It's just that all structure uses are resolved at compile time.
<monochrom>
I am ordered. So I am stupid.
<mrvn_>
But one can't make a "Stupid list" :)
<Smerdyakov>
The inheritance is handled in exactly the same way as in OO.
<Smerdyakov>
It's just that modules don't have first-class runtime existences.
<Smerdyakov>
So "inheritance" is absolutely the wrong way to describe the property that interests you.
<Kevin_>
mrvn_: yep
<Smerdyakov>
mrvn_, and one can't say let x = list + 1
<Smerdyakov>
mrvn_, but that's because that just doesn't make sense, given what 'list' is.
<Smerdyakov>
mrvn_, similarly, "not being able to make a list of Stupids" is just a mal-formed wish.
eugos has joined #ocaml
<mrvn_>
So say I have a bunch of modules with a common interface like "print : unit -> unit" and I want to make a list of them. What choices do I have without classes? Add a function x -> { Base.print_fn = print; } to each one?
<Smerdyakov>
Modules are not cut out for situations like that.
<Smerdyakov>
Objects are a much better fit.
<Smerdyakov>
But I ask you to consider how often you would want such a thing with modules.
<mrvn_>
But slower for static functions.
* Submarine
has hardly ever used objects in OCaml
<Smerdyakov>
Typically, you would want at most one limited case of that per program, as part of an "extension system" or "plugins."
<mrvn_>
Smerdyakov: for example.
<mrvn_>
So any other options than providing a record of dispatch functions?
<Smerdyakov>
Yes. Like I said, objects are a much better choice.
<Smerdyakov>
The objects' classes can even be within modules, if you like.
<Submarine>
objects, essentially, are records containing dispatch functions
<Submarine>
but they are presented in a nice type system
<Submarine>
(hey, like a C++ object is just a struct and a dispatch table, at least with single inheritance)
<mrvn_>
I know. I'm just intrested in the different ways to do it.
monochrom is now known as hilbert
<mrvn_>
Submarine: Actualy it is a tree (or graph) or dispatch tables.
<mrvn_>
Each (x:>other) moves you down the tree (graph) to the ride node.
<mrvn_>
right even
mrsolo has quit [Read error: 104 (Connection reset by peer)]
<mrvn_>
Ok, completly different topic: Any ideas how to make a context sensitive lexer?
<Nutssh>
Was going by memory. Map.S is the output type.
<Kevin_>
The cat name is "roux chat".
<Nutssh>
Write several lexers that invoke each other.
<mrvn_>
Nutssh: How do I pass the input parts from one lexer to the next?
<Nutssh>
Or even write a lexer that rescans an input string.
<Nutssh>
If you're rescanning, just do 'other_lexer_function <any other arguments> lexbuf' where other_lexer_function is another lexer defined in the same .mll file.
<mrvn_>
Hmm, ([^' '] as x) ... { Lexin.from_string x } would work, right?
<Nutssh>
If you're rescanning, extract the matching string you care about from the lexbuf, and create a new lexbuf and 'other_lexer_func <args> lexbuf'
<Nutssh>
Yup.
<mrvn_>
But what if the sub lexer produces multiple tokens?
<Nutssh>
Well, { lexer2 (Lexing.from_string x) }
<Nutssh>
Define the type of the lexer to be '... -> token list'
<mrvn_>
Nutssh: and how does that work with the *.mly grammar then?
<Nutssh>
I don't know. Remember, you have the ability to massage the return type of the sublexer any way you want.
<Nutssh>
{let tokens = lexer2 (Lexing.from_string x) in .... }
<mrvn_>
I guess I have to write a function on top there that caches the token lists internaly and hands out one at a time to the parser then.
<Nutssh>
I've never used the ocaml parsing code, only the lexing code. (Which is *nice*.)
<mrvn_>
yeah. problem is that I want to parse debiand Packages/Sources file and they absolutely aren't lexable.
<mrvn_>
Maybe I should just use *.mly and write the lexer manually.
eugos has quit ["Leaving"]
mrvn has joined #ocaml
Kevin_ has quit ["Quit"]
mrvn_ has quit [Read error: 110 (Connection timed out)]
CosmicRay has joined #ocaml
Submarine has quit ["ChatZilla 0.8.31 [Mozilla rv:1.4.1/20031114]"]
<Nutssh>
What does the file look like?
<mrvn>
Nutssh: did you mean me?
<Nutssh>
mrvn, that looks not too bad to parse. About as hard as parsing email.
* Nutssh
wrote a flex file for doing that in C.
<mrvn>
Problem is that I want to parse the fields into more specific structures. Parsing into a "(string, string) Hashtbl) is trivial.
<Nutssh>
What kind of specific structure? Whats wrong with a parsing it into '(string, string) Hashtbl' and then reparsing that?
<mrvn>
"Version: 0.8.1-11" has to return VERSION Int(0) DOT Int(8) DOT Int(1) HYPHEN Int(11)
<mrvn>
Or something similar.
<mrvn>
I'm trying to avoid to write a seperate lexer and parser for every field.
<Nutssh>
Make a version lexer? Lexers can take arguments, say the list where they accum the stuff.
<Nutssh>
A .mll can contain several lexers. I'm not seeing where the complexity of a LR or LL parser is worth it to parse this.
<mrvn>
I need several lexer because the fields are too different. But different parser?
<mrvn>
Things like that are better parsed with a grammar.
<mrvn>
And thats not even the worst line I have.
<Nutssh>
Ah, Ok.. Maybe make a full featured parser for parsing that sort of line.
<Nutssh>
I'd use a lexer-centric design to lex out each line, then branch out to either a second-pass lexer or second-pass parser&lexer depending on the complexity of the line.
<mrvn>
With a second pass lexer I can just make one big *.mly parser for the full file.
<mrvn>
I only a few cases: Binary -> word list lexer, Version -> version lexer, *Depends* -> depends lexer, Files -> file lexer
GreyLensman has left #ocaml []
<mrvn>
The rest ist all "key: text"
<mrvn>
forgot the "source:" entry.
kinners has joined #ocaml
<mrvn>
Thanks for all the ideas by the way.
<Nutssh>
You have two levels of data encapsulation, so why not a seperate lexer/parser for each one? have you read RFC 1925? See point #5.
<Nutssh>
Sure.
hilbert has quit ["I quit, therefore I don't exist"]
<mrvn>
As long as I can keep it down to one *.mll and one *.mly file. But I just figured out that I can have multiple "%start symbol" lines in one *.mly file and thus multiple parsers.
<mrvn>
Hmm, but I can't start another parser from inside the same mly file.
<Nutssh>
No problem with multiple mll files.
<Nutssh>
And, you can have several lexers in one mll file.
<mrvn>
multiple mly files you mean.
CosmicRay has quit [Read error: 113 (No route to host)]
<Nutssh>
I don't know about multiple .mly files.
<Nutssh>
Multiple lexers is, see 12.2 in the manual.
<mrvn>
lexer are not the problem.
<mrvn>
Now I'm searching for a way to get something into the *.mli file generated by the *.mly.
<mrvn>
Doesn't look like I can.
Tristram has joined #ocaml
<mrvn>
Anyone user *.mly files before?
<mrvn>
Anyone used *.mly files before?
CosmicRay has joined #ocaml
<kinners>
mrvn: I've done a simple language parser but nothing advanced
<mrvn>
I want the start symbol to return a "%type <entry list> main" and type entry is defined in the header. But it doesn't show up in the *.mli file and that then fails to compile.
<mrvn>
Do I have to move the type definition to a seperate file and use <File.entry list>"?
<kinners>
mrvn: that's what I did
<kinners>
mrvn: having the type in a seperate file