<mfurr>
Its probably trying to remove warnings when using the macros
<urz>
yeah
<mfurr>
ala: caml__dummy_## is unused
demitar__ has quit [Read error: 54 (Connection reset by peer)]
demitar__ has joined #ocaml
<urz>
uh
<urz>
#define can be used in ocaml source?
<urz>
or are they processing this with a c preprocessor? heh
<mfurr>
ocaml is usually preprocessed with camlp4
<mfurr>
(which can do things like #define)
<urz>
oh
<urz>
does it also understand /* */ comments?
<urz>
if i'm interfacing readline, do i need to make a .ml file? it seems i should only need a .mli and a .c file
<mfurr>
camlp4 is a framework for extending the ocaml syntax... so you kinda do whatever you want with it(almost)
<mfurr>
if all you have is "external" calls, then an .mli file will be fine
fariseo has quit [Client Quit]
fariseo has joined #ocaml
mfurr has quit ["..zzZZ"]
monotonom has quit ["Don't talk to those who talk to themselves."]
fariseo has quit [Client Quit]
fariseo has joined #ocaml
Hadaka has quit [Read error: 110 (Connection timed out)]
shawn has quit [Connection reset by peer]
Naked has joined #ocaml
Naked is now known as Hadaka
shawn has joined #ocaml
kosmikus|away is now known as kosmikus
Nate75Sanders has joined #ocaml
bk_ has joined #ocaml
gim has joined #ocaml
mrsolo_ has quit [Read error: 104 (Connection reset by peer)]
mrsolo_ has joined #ocaml
karryall_ has joined #ocaml
mrsolo_ has quit [Connection timed out]
demitar__ has quit [Read error: 54 (Connection reset by peer)]
demitar_ has joined #ocaml
fariseo has quit [Client Quit]
Pilot0541 has joined #ocaml
Pilot0541 is now known as Zaius
<Zaius>
hi, i wanted to recursively drop every second element from a list, like this
<Zaius>
let rec decr_rd = function
<Zaius>
| [] -> []
<Zaius>
| h::[] -> h
<Zaius>
| h::i::t -> ( decr_rd h )::( decr_rd t )
<Zaius>
but that needs lazy types and runtime type-checking. how can i do it elegantly?
demitar_ is now known as Demitar
<Demitar>
How about using a state variable?
<Zaius>
state of what?
<Demitar>
let decr_rd lst = let rec internal lst drop = match lst, drop with [], _ -> [] | hd :: tl, true -> internal tl false | hd :: tl, false -> hd :: (internal tl true) in internal lst true
<Demitar>
Not tail recursive, but I let that be an excercise for the reader. ;-)
<Zaius>
but that's just a regular drop function. what i meant to do was
<Demitar>
segphault, well do you have previous knowledge of OpenGL? It's pretty much the same.
_shawn has joined #ocaml
shawn has quit [Read error: 104 (Connection reset by peer)]
benja has joined #ocaml
dobrek has joined #ocaml
<dobrek>
hi: I am pretty fresh to ocaml so a simple question: Why is it so :
<dobrek>
This expression has type
<dobrek>
(< at : int -> int -> value; fill_it : 'b -> 'c; nbr_cols : int;
<dobrek>
nbr_rows : int; set : int -> int -> Pool.value -> 'd; .. > as 'a) ->
<dobrek>
int -> int -> Read.reader -> Read.reader
<dobrek>
but is here used with type 'a -> int -> int -> 'e -> 'e
<dobrek>
shell it not much ?
<benja>
what is the error message ?
<dobrek>
This is the error message
<benja>
ah yeah ;)
<dobrek>
I would chenge "is here used" to "I think I am using it as" :))
maihem has joined #ocaml
<benja>
ok so try to explicit the type of the object parameters to your function for the last two
<benja>
let myfun a i1 i2 (r1 : #Read.reader) (r2: #Read.reader) = ...
<dobrek>
This expression has type
<dobrek>
(< at : int -> int -> value; fill_it : 'b -> 'c; nbr_cols : int;
<dobrek>
nbr_rows : int; set : int -> int -> Pool.value -> 'd; .. > as 'a) ->
<dobrek>
int -> int -> Read.reader -> Read.reader
<dobrek>
but is here used with type 'a -> int -> int -> Read.reader -> Read.reader
<benja>
yeah and for the first one (a : #classname ) or (a: <the_method_that_you_re_using>)
<dobrek>
benja: This is harder because I am using it inside one of the functions of this object which i am passing as a first parameter.
<Demitar>
Do you want it to be polymorphic, or?
rox has quit [Connection timed out]
<dobrek>
benja: Is it an error ?
<benja>
i don't know
<dobrek>
Demitar: Yes I do. I want to define myself iterator over this object. Actually this is a siganture of the function taken by this iterator.
<benja>
just try an open type with the method that you're using
<dobrek>
Demitar: to iterate
<dobrek>
i.e. ?
<benja>
( o : < methoda : type ; methodb : type; .. >)
<Demitar>
So you want let ['a] myfun ( o : < methoda : type ; methodb : type; .. >) i1 i2 (r1 : 'a) (r2 : 'a) = ... or?
* Demitar
gratiously stole the open class type from benja of course. ;-)
<benja>
let ['a] ??
<Demitar>
To say it's a polymorphic type (rather than just inferred).
<Demitar>
Or did I mix it up with the classes ('a) vs ['a]?
<dobrek>
Demitar: it is a function which takes an object takes two ints, takes smthing 'a and return 'a
<dobrek>
sorry for slow reaction but I am trying to spcfy this type
<Demitar>
By the way, aren't open types simply constraints and the full type is inferred later on?
<benja>
dobrek: so you have an object with a method to iterate over an another object ?
* Demitar
can't seem to remember.
<Demitar>
Perhaps: let ['a] myfun (o : < next : 'a -> 'a; >) i1 i2 (r1 : 'a) (r2 : 'a) = ... And coercing the passed in classes.
shawn has joined #ocaml
_shawn has quit [Read error: 104 (Connection reset by peer)]
<benja>
the let ['a] means nothing and it's illegal
<benja>
dobrek: what's going on ?
<dobrek>
This expression has type
<dobrek>
< at : int -> int -> value; fill_it : 'a -> 'b; nbr_cols : int;
<dobrek>
nbr_rows : int; set : int -> int -> value -> unit; .. >
<dobrek>
but is here used with type
<dobrek>
< at : int -> int -> value; fill_it : 'c -> 'd; nbr_cols : int;
<dobrek>
nbr_rows : int; set : int -> int -> value -> unit >
<dobrek>
Self type cannot be unified with a closed object type
<dobrek>
benja: sorry but you cannot use kwd method in specyfing an open type in opposite to your suffestion. It took me a bit to figure it out.
<dobrek>
s/ff/gg/
<benja>
can you show us what is the line of code involved ?
<dobrek>
shue
<dobrek>
give me two minutes I will cleen it up a bit
<dobrek>
ok this is a function :
<dobrek>
let iterate ( aPool : <
<dobrek>
fill_it : 'b -> 'c;
<dobrek>
nbr_cols : int;
<dobrek>
nbr_rows : int;
<dobrek>
set : int -> int -> value -> unit;
<dobrek>
at : int -> int -> value; > ) aFunc ( aParams : #Read.reader ) =
<dobrek>
let nbr_rows = aPool#nbr_rows in
<dobrek>
let nbr_cols = aPool#nbr_cols in
<dobrek>
let params = ref aParams in
<dobrek>
for r = 0 to nbr_rows do
<dobrek>
for c = 0 to nbr_cols do
<dobrek>
params := aFunc aPool r c !params ;
<dobrek>
done;
<dobrek>
done;
<dobrek>
the object has couple of methods one of them is the following:
<dobrek>
method fill_it aStream =
<dobrek>
let set_it aPool r c ( stream : Read.reader ) =
<dobrek>
let new_value = stream#next () in
<dobrek>
let _ = aPool#set r c new_value in
<dobrek>
stream in
<dobrek>
iterate self set_it aStream ; ()
<dobrek>
this is the method which uses the function iterate which I pasted before. This is also the source of error. Type system claimes that "self" has an unmatched type.
<dobrek>
i.e. that the type of "self" cannot be unified with the type of the first parameter of iterate.
<benja>
why don't you simply add a method iterate (even private) to your pool object ?
<dobrek>
benja: because I would like to have severa different implementation of pool :((
<benja>
can't you just do that with different subclasses ?
<dobrek>
benja: and make iterate polimorfic, use only an interface to it.
<dobrek>
and make iterate a part of a base class yes I can. It a bit contradicts my esthetic. But it is not really an answer to the question. I think I will ask on a mailing list, anyway there is not much traffic.
<dobrek>
benja: thanks a lot anyway.
<benja>
allright my bad, instead of doing specifiying the type on the function declaration, try to coerce it on the invocation with ( o :> type )
<dobrek>
appart of the solution I am simply curious why is it so.
<benja>
and maybe it's easier to create a iterator as an polymorphic class
<Demitar>
benja, am I confusing ['a] with type declarations? (Getting pretty late over here.)
<benja>
as far as I know. ['a] is only using in class type definition
<benja>
class [
<Demitar>
Well s/[]/()/ then.
<benja>
class ['a] iterator (object : 'a) = object constraint 'a #skel_pool method iterate...
<dobrek>
benja: the same. It suggest that my self doesn't much. I will double check it.
<benja>
so you tried (self :> #skel_spool) ?
<dobrek>
no I tryed ( self : < at -> int -> int ; and so on >
<benja>
you should coerce it with :> class_type
<benja>
class_type is either <method : type > or #class_name
<dobrek>
benja: I tryed the result is :
<dobrek>
This expression has type
<dobrek>
< at : int -> int -> value; nbr_cols : int; nbr_rows : int;
<dobrek>
set : int -> int -> Pool.value -> 'a > ->
<dobrek>
int -> int -> Read.reader -> Read.reader
<dobrek>
but is here used with type
<dobrek>
< at : int -> int -> value; nbr_cols : int; nbr_rows : int;
<dobrek>
set : int -> int -> value -> unit > ->
<dobrek>
int -> int -> (#Read.reader as 'b) -> 'b
<dobrek>
da but now it is indeed somehow different
<benja>
check you set method
<benja>
it should return 'a... but unit
rox has joined #ocaml
<dobrek>
taa the problem is that all of it happend in the file pool.ml He got this Pool.value probably from the interfase of this reader
<benja>
also, don't forget to catch the stream exception
<dobrek>
benja: I want, thanks.
<benja>
oh my bad i didn't see that it was your own type
<dobrek>
s/want/won't/
<benja>
also I don't understand why you're messing arround with the param; shouldn't be easier to do iterate self (set_it aStream) ?
<dobrek>
benja: I still don't know how to make it working no I have a complain that Read.next returns Pool.value not a "value"
<dobrek>
benja: for stream it will work but I am hoping to use the iterator also for different purposes. This is why I mess so much with params.
<benja>
open Pool ;-) sounds like a namespace conflict
<benja>
you underestimate the power of partial application
<benja>
rewrite you set_it like this : set_it stream apool r c
<benja>
and iterate with iterate self (set_it astream)
<benja>
no you can even iterate function without parameters
<dobrek>
thanks this is true. But first I'll solve my initial problem.
<benja>
ok but I'm sorry I can't really help you more, I'm sure you'll figure out what 's wrong pretty soon
<benja>
see ya
<dobrek>
benja: thanks a lot
<dobrek>
benja: I will
Submarine has joined #ocaml
<Submarine>
wow what a large community
<dobrek>
Submarine: ?
<karryall>
dobrek: doesn't it work if you just remove the type annotation ?
<Submarine>
dobrek: I'm always surprised at the number of people in that channel.
<dobrek>
Submarine: positivelly or negatively ?
<Submarine>
Positively.
<Submarine>
Not bad for a French academic programming language.
<Smerdyakov>
It's hardly just academic anymore.
<dobrek>
karryall: I think I have to read smth more about modules and compilation units in ocaml. Untill now I spend most time in batch mode.
<karryall>
dobrek: yeah definitely, ocaml code is really meant to be compiled
<dobrek>
Submarine: wasn't it like that thet until java everything was a sort of an academic.
<Submarine>
?
<Submarine>
Well, I'd say that until Java there was no widespread garbage collected language.
<Submarine>
Common Lisp does not count as widespread.
wolfman8k has joined #ocaml
<dobrek>
Submarine: I thought that most of languages were developed on universities.
<Submarine>
Not necessarily.
<Submarine>
C was developed at ATT.
<wolfman8k>
is it a bad idea to learn ocaml if i don't know anything about functional programming?
<Submarine>
ADA was developed at CII-Honeywell-Bull.
<Submarine>
wolfman8k: No. Some universities use OCaml as an introductory language.
<karryall>
s/ADA/Ada
<wolfman8k>
so is the tutorial in the topic a good place to start?
<Submarine>
The tutorial in the OCaml documentation is ok I think.
<Submarine>
Some say the OCaml book at O'Reilly is good.
<mellum>
it depends on your previous knowledge, I'd guess
<dobrek>
Submarine: still I am happy this language exist. It is plasure to learni it.
<karryall>
wolfman8k: not really, it insists too much on the imperative aspects, so if you want to learn functional programming, that's not great
<dobrek>
wolfman8k: there exist such a tutorial ocaml for c++, java, perl programmers it was good to read.
<karryall>
the o'reilly book is excellent, but that's a whole book, not a tutorial
<Submarine>
Well, I think that OCaml is a very good language for many usages.
<wolfman8k>
the thing is, i'm not really sure that i want to use ocaml for functional programming
<Submarine>
What do you want to do?
<wolfman8k>
i'm not really sure. i want to do what's best :)
<wolfman8k>
but i don't really know much about functional yet, so i don't know
<wolfman8k>
but is functional programming good for like, gui apps, like a word processor?
<wolfman8k>
and is ocaml fast enough, for like, a ray tracer 3d renderer?
<wolfman8k>
or maybe i should just talk less, and read and learn more? :)
<Submarine>
Certainly faster than Java.
<Submarine>
Functional programming is good for GUIs because it makes registering callbacks easy.
<Submarine>
Compare with Java, where you have to introduce spurious "listeners" that clutter your code.
<mellum>
Ocaml is not very good for floating point calculations.
<Submarine>
Rectification.
<wolfman8k>
mellum: hm.. that sounds bad
<Submarine>
OCaml is not very good for computations involving a lot of floating-point, like matrix multiplications.
<wolfman8k>
that sounds very bad
<Submarine>
Of course, you don't do matrix multiplications in OCaml. You call LAPACK or BLAS.
<wolfman8k>
hm?
<Submarine>
If you are to inverse a 1000x1000 matrix, you call LAPACK.
<mellum>
Submarine: for that, *any* language is good.
<mellum>
but it doesn't help for a raytracer.
<wolfman8k>
is LAPACK some sort of math library?
<Submarine>
LAPACK is a library of linear algebra.
<Demitar>
wolfman8k, basically, it's the garbage collector forcing most numbers to be boxed which has a performance impact.
<Demitar>
s/most/some/
<Submarine>
Demitar: But it can easily be mitigated because vector coordinates are unboxed.
<dobrek>
wolfman8k: LAPACK is written in FORTRAN it is very good. If you want to have as fast things as LAPACK maybe you should use FORTRAN. I thing FORTRAN 90 has already passing values by value.
<Submarine>
wolfman8k: What Demitar alludes to is that the OCaml runtime allocates floating-point values in memory in their own individual "cells". Still, this is mitigated by various optimizations.
<Submarine>
Like arrays of floats are not arrays of pointers to floats, they are real float arrays. Ditto for records containing only floats.
<Submarine>
Plus, the compiler allocates temporaries in registers.
<Submarine>
Another thing is that OCaml is bad for multiprocessor multithreading.
<mellum>
Still, if you want to write a raytracer, Ocaml is not the language for you. Its advantages don't help there.
det is now known as TheSoundOfFire
<Submarine>
mellum: I disagree to some extent.
<Submarine>
mellum: A raytracer uses lots of lists and trees.
<wolfman8k>
so are there any other good very high level langauges (not necessarily functional) that would be good for a raytracer?
TheSoundOfFire is now known as det
<Submarine>
mellum: The actual floating-point computations are hidden in a mix of other stuff.
<Demitar>
IIRC there are a few ocaml raytracers out there, right?
<Submarine>
mellum: Java is horrible for a raytracer.
<Submarine>
wolfman8k: Ada.
<mellum>
Submarine: Java is horrible for anything; that's not a poinr.
<Submarine>
wolfman8k: Heavily templated C++.
<Demitar>
wolfman8k, why are you writing a raytracer?
<wolfman8k>
well, i know c++ pretty good so far, and some things i really don't like about it
<Submarine>
I think that OCaml works for a raytracer.
<Submarine>
Have you profiled yours to check where time is spent?
<Demitar>
If it's for learning OCaml is a decent choice. If you have a big project in mind I really wonder if you're sane considering the huge amount of raytracers already out there.
<wolfman8k>
well, actually i'm not really interested in a raytracer
<Demitar>
In general I find OCaml to be the best language so far. :)
<wolfman8k>
just projects that have similar aspects to a raytracer in terms of performance needs
<wolfman8k>
Demitar: what about lisp or haskell? :)
<mellum>
well, lisp, being dynamically typed, would probably be much slower, unless you introduce ugly type annotations
<Demitar>
wolfman8k, ))))) and haskell is neat but I still prefer OCaml.
<Riastradh>
mellum, nothing prevents static type analysis in Lisp; Olin Shivers' PhD thesis explains how.
<wolfman8k>
so in general, ocaml compiles to efficient machine code?
<Demitar>
We can always point you to the shootout. ;-)
<Submarine>
Lisp is likely to be slow, and plus I find programming in Lisp tiresome.
<Demitar>
wolfman8k, 1) yes 2) that's much less of a problem than you think.
<Submarine>
Lisp is like Perl: you discover stupid mistakes at runtime.
<Submarine>
Riastradh: "nothing prevents static type analysis in Lisp". Oh, only Rice's theorem. :-)
<Riastradh>
Rice's theorem?'
<Demitar>
I have yet to write and OCaml application where it's really meaningful to compile it to native code rather than bytecode.
<mellum>
Riastradh: do common compilers do it? Does it work well in practise, and not just in thesises?
<Submarine>
Riastradh: Any nontrivial property on the denotational semantics of programs is undecidable. Any static analysis of types is therefore necessarily imprecise (either too restrictive, either not enough).
<Submarine>
Demitar: Oh, I have one.
<Riastradh>
mellum, I'm pretty sure Python, LIAR, and Stalin all perform some form of static type analysis and do something useful with it.
<Riastradh>
I could be thinking of a different CL compiler.
<det>
Riastradh: "Python"!?
<mellum>
Riastradh: nearly. It doesn't do a lot of optimizations. Nobody cares much; it's fast enough for what it's used.
<Riastradh>
det, uh, yes...Python...
<mellum>
last time I looked, it didn't even fold constant expressions.
<mellum>
(but that was a few years ago)
<det>
mellum: I dont think it has changed
<Riastradh>
Straight from the cmucl main page:
<Riastradh>
'a sophisticated native-code compiler which is capable of powerful type inferences'
<det>
Riastradh: how does cmucl compiled binaries compare with C, Ocaml or MLton ?
<Riastradh>
I don't know; I've never compared them. (And 'C' is far too general; gcc will pretty consistently produce _much_ worse code than icc or xlc, for instance.)
<det>
what is xlc ?
<Riastradh>
IBM's C compiler for the PPC.
<Submarine>
icc... the "inch allah compiler".
<Submarine>
Well, a crucial thing is that better or worse compilers just change speed by a constant factor.
<Submarine>
On the other hand, changing languages may make using advanced data structures easier.
<Submarine>
Somebody who codes in C may choose some simple but inefficient structures like linked lists.
<det>
while a perl hacker has all of CPAN at his disposal. Good point!
<det>
Riastradh: Has Olin's reaserch provided insight into the limit on what information static type analysis may recover?
<Submarine>
While a Perl hack has CPAN, and a OCaml hacker uses the standard library, or may write other structures very easily.
<det>
Riastradh: And what are the requirements? Whole-program compilation?
<Riastradh>
det, his PhD thesis was on CFA in functional languages in general; the section on static type analysis for dynamically typed languages like Scheme was just one of his example applications of the rest of the thesis.
<Riastradh>
det, and no, it wouldn't require whole-program compilation.
<wolfman8k>
ok, i think i'm gonna start with scheme
* Riastradh
points at #scheme.
<Submarine>
Scheme?
<Submarine>
For a raytracer?
<Submarine>
ROTFL
<wolfman8k>
hm... it's funny? :o
<Riastradh>
What's so hilarious about that? I bet Stalin could easily beat ocamlopt at it.
<wolfman8k>
stalin? :O
<mellum>
how about bash? x=`expr $y * $z`
<Submarine>
Well, programming complex apps in untyped languages is difficult, in my experience.
<wolfman8k>
you need to escape the * character
<Submarine>
I did enough common lisp to notice that.
<det>
Submarine: not untyped
<Riastradh>
Untyped languages? That would be like Forth.
<Riastradh>
Scheme is _dynamically_ typed, and Stalin performs static type analysis anyways.
<Submarine>
That's not the point.
<Riastradh>
What is the point, then?
<Submarine>
The point is that typically you discover your type errors at runtime.
<Submarine>
I'm not even discussing efficiency.
<Riastradh>
Submarine, and since Stalin performs static type analysis, it can report type errors at compile-time.
<Submarine>
It can. Does it do it? Is it usable?
* Submarine
had a horrible Common Lisp experience.
<Riastradh>
OK, for general program development Stalin is horrible. However, there are even other Scheme systems that have more gearage towards development, such as Scheme48, that perform static type analysis and can report type errors at compile-time.
<Submarine>
But don't you agree that for beginners this is not really intuitive how to use such functionalities?
<Riastradh>
?
<Submarine>
I mean, typing is natural in OCaml.
<Submarine>
Typing in Lisp involves adding annotations.
<Riastradh>
Not in Scheme48, unless you want to.
<Submarine>
I don't know the type system in Scheme, but the one in CL is not polymorphic if I remember well.
<Riastradh>
Sure, Scheme48's type system isn't great, but it nevertheless does constitute some form of static type verification.
<Riastradh>
s/Scheme48's type system/Scheme48's static type system/1
demitar_ has joined #ocaml
Demitar has quit [Connection reset by peer]
<Submarine>
I wonder whether it'd be possible to speed up the GC with cache prefetches.
<wolfman8k>
definetly
<wolfman8k>
;)
<mellum>
Submarine: huh? how should that work?
<Submarine>
You tell the processor to begin fetching data when you know you'll need it.
<Submarine>
For the minor GC that sounds doable.
<mellum>
I don't see the point.
<mellum>
You don't know you'll need some data way before you actually need it when doing GC
<Submarine>
Not always.
<Submarine>
Depends on how you implement it.
<Submarine>
Let's say you have a simple GC that marks stuff (essentially, computes a closure in a graph).
<wolfman8k>
what's the "normal" ocaml implementation: ocaml or ocamlb?
<Submarine>
You are scanning object A which points to B and C.
<Submarine>
You may tell the processor to prefetch C while you're scanning B.
<dobrek>
Is there some constraction in ocaml which I could use to guaranty myslef that some object can be constructed only by a particular function. And it cannot be constructed by anybody else ? Like private constructed together with friendship declaration ?
<mellum>
Submarine: hm, maybe
<mellum>
Submarine: you can try it, source is available :)
<Submarine>
dobrek: That's easy with module signatures and abstract types.
<dobrek>
ok. I thought there is some other more oo - oriented way.
<Submarine>
Well, you can hide the object constructors, can't you?
Submarine has left #ocaml []
<karryall>
dobrek: in the signature, declare your class as a class type and give a constructor function
<dobrek>
karryall: but this doesn't prevent me form constructing this class however I want
benja has quit ["Leaving"]
<karryall>
yes it does
<karryall>
you can only construct it with the constructor function
<dobrek>
karryall: a so perhaps I don't know smth.
<karryall>
in your .ml file:
<karryall>
class foo = object method truc = 42 end
<karryall>
let make_foo () = new foo
<karryall>
in the .mli file :
<karryall>
class type foo = object method truc : int end
<karryall>
val make_foo : unit -> foo
<dobrek>
thanks I will do like you suggest it is much easier than module base approach
<wolfman8k>
hm... ocaml seems yummy
maihem has quit ["Read error: 54 (Connection reset by chocolate)"]
<wolfman8k>
is it true that ocaml doesn't have single precision floating point numbers?
<karryall>
yep, only double
<wolfman8k>
ouch :(
<wolfman8k>
it uses the fpu though, right?
<karryall>
of course
<wolfman8k>
*phew* :)
<wolfman8k>
guess single precision floating point isn't really needed nowadays
<karryall>
no, doubles are fine really :)
<wolfman8k>
is it true that all the error messages were translated from french? :)
<karryall>
hmm don't know, maybe a long time ago
Iter has joined #ocaml
gim has quit []
urz has joined #ocaml
<urz>
hello
<urz>
interfacing C to ocaml, if i want the ocaml to be able to read and write a public variable exported by the c module, do i need to make getter and setter functions? or is there a way to bind it to a variable with automatic glue?
<karryall>
you need a getter and setter
<urz>
thanks
<wolfman8k>
sorry if this is a rtfm question, but how can i compile into native code? ocamlc seems to be the bytecode compiler
<gl>
use ocamlopt
<karryall>
ocamlopt is the native code compiler
<wolfman8k>
thanks you
<wolfman8k>
hm... it apparently doesn't have the same syntax as ocamlc
<karryall>
there's a few differences yes
<karryall>
I mean in the command line
<karryall>
but they compile the same source code
<wolfman8k>
ok thanks, i'll stick with ocamlc for now then
<urz>
are ocaml io channels equivelent to c library FILE * streams? Can a c function that takes a FILE* be wrapped as an ocaml function that takes a channel?
<urz>
in other words, how do i wrap a c function that takes a FILE * ?
<urz>
heh
<karryall>
yes, it's possible but it's a bit of work
<karryall>
the headers describing the C-side structure of caml channels is not installed
<karryall>
you have to get it from the source tree
<wolfman8k>
hm... does one generally use make with ocaml, or does ocaml have it's own build system?
<karryall>
it's in byterun/io.c
<Riastradh>
One usually uses the OCamlMakefile thing.
<wolfman8k>
ok thanks
<karryall>
urz: a channel is a custom block to a C struct
<karryall>
in this C struct there's a fd field with a file descriptor
<karryall>
you can turn it into a FILE* with fdopen
<urz>
oh
<karryall>
it's probably a good idea to dup() it first
<karryall>
byterun/io.h
<karryall>
not io.c
<urz>
this is a call back interface.. the c library expects you to provide a callback that takes a FILE* and i want to let the ocaml coder use a function that takes a channel
<urz>
so really, i have to convert FILE* into channel
<urz>
oh well
<urz>
maybe i can let the caml code use a Unix.file_descr instead
<urz>
and i convert the FILE* into a file descripter
tyler has joined #ocaml
<karryall>
yep
<karryall>
no need to bring a dependency on Unix
<karryall>
you can build a channel on the C side
<urz>
oh
<karryall>
see caml_open_descriptor_in in io.c
maihem has joined #ocaml
maihem has quit [Read error: 104 (Connection reset by peer)]
<karryall>
oh no that's the CVS version I'm talking about
<karryall>
they made this big namespace change with C functions
<karryall>
prefixing everything with caml_
<urz>
i'm using a version in debian
<urz>
debian testing
<urz>
so if i use this function, it will break when i upgrade?
<urz>
i'll need to change the name?
<urz>
heh
<karryall>
no, there will be some macro magic to avoid this.
<urz>
but i'm not even getting it in a .h
<urz>
i have to provide the prototype, right?
<karryall>
yes, or you just copy byterun/io.h into your source tree
<urz>
but upgrading wont upgrade my copy of io.h to get macro magic
<karryall>
ah er yes you're right
<karryall>
too bad
<karryall>
you still have time to file in a bug asking for io.h to be installed :)
<urz>
time before what? their next release?
<karryall>
yes
pattern has quit [Success]
<dobrek>
is it possible in ocaml to have two modules which have smhow cyclic dependence. I. e. one for instance defines a type the other defines a function which returns this type and the first uses this function. I would like to have those modules in separate files on top of that, ?
<dobrek>
probably but I am simply too tired to think anymore. whatever I do i finish with this value has type M.type_def_in_M while it should have type type_def_in_M.