flux changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | 3.11.0 out now! Get yours from http://caml.inria.fr/ocaml/release.html
<mrvn> Can a class has a static method?
jlouis has joined #ocaml
mwhitney__ has quit [Read error: 110 (Connection timed out)]
Yoric[DT] has quit ["Ex-Chat"]
slash_ has quit ["leaving"]
jeanbon has quit ["J'y trouve un goût d'pomme."]
Alpounet has joined #ocaml
jeddhaberstro has joined #ocaml
<mrvn> In case anyone wakes up here is my problem: I have different types of blocks on disk that all have a common header. So I though I would create a header class and have type1, type2, type3, ... all inherit header. Class header has a virtual methods get_magic and add_to_buffer and method to_buffer. Now here is the problem: Each typeX can be created fresch with initial values or from a buffer. I would like to have 2 constructors in some way.
<mrvn> I also have type2a and type2b that inherit type2 and same for type3.
<mrvn> My (not realy working) solution so far is: type args = Create of int64 * int64 * int64 | Buffer of Aio.buffer * string class virtual header args = let (parent, block_id, generation) = match args with ...
<mrvn> which breaks down when inheriting.
<Alpounet> parametrical polymorphism isn't sufficien in your case ?
<Alpounet> sufficient*
mwhitney__ has joined #ocaml
Camarade_Tux has quit ["Leaving"]
mwhitney__ has quit [Read error: 110 (Connection timed out)]
<mrvn> how do you mean?
oriba has quit ["Verlassend"]
<mrvn> Alpounet: Do you mean a 'a header type?
<Alpounet> yes
<mrvn> That might work. Would be somewhat upside down to how objects inherit.
<mrvn> The 'a would then have to be { from_buffer : Aio.buffer -> 'b; into_buffer : 'b -> Aio.buffer -> unit; ... }
<Alpounet> 'b ?
<mrvn> The internal representation of typeX
<Alpounet> ok
<mrvn> Header.from_buffer and Header.to_buffer then is easy.
<Alpounet> yes
<Alpounet> that's what made me think about a 'a header type
<mrvn> But what about Header.make to create a fresh one in memory?
<Alpounet> how to choose it, you mean ?
<mrvn> Hmm, make : 'a -> 'b -> 'a t could work.
<Alpounet> sounds logical at least.
<mrvn> I need a Type1.make : arg1 -> arg2 -> Type1.t Header
<mrvn> Maybe a functor is better though.
<mrvn> Building the { from_buffer ... } record is basically what the functor does automatically.
<mrvn> In C++ one would just write class Foo { Foo(int x, int y); Foo(Buffer buf); ...}
verte has joined #ocaml
<mrvn> Alpounet: One drawback of this will be that I need to use Type1.fn (Header.get_actual obj) instead of obj#Type1.fn
<Alpounet> Yes...
<mrvn> Worse for functions that alter the objects: let new_obj = Header.call obj Type1.fn. Although that doesn't seem too bad.
<Alpounet> Some people prefer this way, others don't...
<Alpounet> You can play with references, if really needed.
<mrvn> I'm trying to keep this functional.
<Alpounet> I would do so too, heh.
<mrvn> Not sure though if it really makes sense in the end.
<mrvn> I have concurrent operations on a big tree. So when one thread blocks it will have to start fresh from the root of the tree the next time it runs because another thread might alter the tree and create a completly new root.
<mrvn> With an imperative tree I could store parent pointers in the nodes and go up and down the tree at will as long as no two threads alter the same node.
<mrvn> I wonder what will be cheaper. Going down the tree again and again or complicated locking.
<Alpounet> Such operations are much better handled by imperative structures, AFAIK.
Ched has quit [Read error: 60 (Operation timed out)]
<mrvn> binary trees work quite nicely in functional style.
Alpounet has quit [Remote closed the connection]
Ched has joined #ocaml
mwhitney__ has joined #ocaml
seafood has quit []
jeddhaberstro has quit []
seafood has joined #ocaml
seafood has quit []
mwhitney__ has quit [Read error: 110 (Connection timed out)]
mwhitney__ has joined #ocaml
mwhitney__ has quit [Read error: 110 (Connection timed out)]
mwhitney__ has joined #ocaml
mwhitney__ has quit [Read error: 110 (Connection timed out)]
mwhitney__ has joined #ocaml
ttamttam has joined #ocaml
Snark has joined #ocaml
mwhitney__ has quit [Read error: 110 (Connection timed out)]
agentcoops has joined #ocaml
mwhitney__ has joined #ocaml
agentcoops has quit [Read error: 60 (Operation timed out)]
mwhitney__ has quit [Read error: 110 (Connection timed out)]
mwhitney__ has joined #ocaml
kelaouchi has quit ["Lost terminal"]
seafood has joined #ocaml
mwhitney__ has quit [Read error: 110 (Connection timed out)]
_zack has joined #ocaml
oriba has joined #ocaml
mwhitney__ has joined #ocaml
Camarade_Tux has joined #ocaml
mwhitney__ has quit [Read error: 60 (Operation timed out)]
mwhitney__ has joined #ocaml
Mr_Awesome has quit [Remote closed the connection]
jeanbon has joined #ocaml
slash_ has joined #ocaml
abtok has joined #ocaml
<abtok> hi, where can i find extBig_int.ml in order to create random big_ints ?
hkBst has joined #ocaml
ttamttam has left #ocaml []
<abtok> i can't find the function random_big_int
<mfp> abtok: should be in Batteries' tree
<mfp> oops, that extBig_int.ml doesn't include any random stuff, you need rwmjones'
authentic has quit [Read error: 60 (Operation timed out)]
<abtok> what is that ?
blAckEn3d has joined #ocaml
<mfp> it seems rwmjones wrote an extBig_int.ml for extlib which included a function to generate random big_ints
kelaouchi has joined #ocaml
<mfp> OCaml Batteries Included (http://batteries.forge.ocamlcore.org/) inherits extlib and also has got an extBig_int.ml, which however lacks such functionality
<abtok> so is there a solution ?
<blAckEn3d> hi.. is there a way to evaluate expressions in the contest of a given module? e.g. instead of using MyModule.func 1 to have something like with MyModule do func 1?
<blAckEn3d> *context
jeanbon has quit [Read error: 113 (No route to host)]
<mfp> abtok: hopefully rwmjones will come back, and there's a chance he still has got that function around
<abtok> ok ; i think i'll just write my own function that creates a random string then convert it to num
<mfp> generating random ints and operating with them should be faster
<mfp> blAckEn3d: open MyModule
<blAckEn3d> mfp: i wante something more.. local.. something with limited scope
<mfp> there's also the open_in extension (included in Batteries) which provides scoped open as in open MyModule in func 1
<abtok> mfp: who can i operate on them without string_of_int them ?
<blAckEn3d> thanks
<abtok> how*
<mfp> abtok: generate random ints with Random, use big_int_of_int, multiply & add them
<abtok> yes ok
jeanbon has joined #ocaml
<mfp> (you'd normally just shift left, but it's seemingly missing in Big_int)
<abtok> multiply by 2^32 the last result ?
<mfp> by big_int_of_int32 0x7000000l I think
<mfp> (on x86)
<abtok> why not 2^32 ?
<mfp> actually, both x86 and x86-64
<mfp> because Random returns a 31-bit int, 0 - 0x3FFFFFF
<abtok> ok
<abtok> so 2^31 then ?
<mfp> +signed
oriba has quit ["Verlassend"]
<abtok> Random.int bound returns a random integer between 0 (inclusive) and bound (exclu‐
<abtok> sive). bound must be greater than 0 and less than 2^{30.
<abtok> so i just multiply by 2^30 in fact
<mfp> 2 ^ 30 = 0x40000000
<mfp> right
<abtok> ok
<abtok> and how can i know how many times do i have to do the shift and add since i can't calculate the log of a Num (big_int) ?
<mfp> you can convert it to a float and compute its log
<abtok> hm sorry, i just have to String.length the string_of_num
<mfp> or keep dividing the bound by 2^30
authentic has joined #ocaml
blAckEn3d has quit [Read error: 54 (Connection reset by peer)]
Yoric[DT] has joined #ocaml
mwhitney__ has quit [Read error: 110 (Connection timed out)]
Amorphous has quit ["shutdown"]
mwhitney__ has joined #ocaml
_zack has quit ["Leaving."]
Amorphous has joined #ocaml
Ppjet6 has quit [Read error: 110 (Connection timed out)]
mwhitney__ has quit [Read error: 110 (Connection timed out)]
bluestorm has joined #ocaml
mwhitney__ has joined #ocaml
ttamttam has joined #ocaml
ttamttam has left #ocaml []
<mrvn> http://paste.debian.net/31760/ How do I haveto write the "next" type so this works?
<flux> hmm
<flux> which type do you mean?
<mrvn> mutable next : 'a t
schme has quit ["leaving"]
<flux> you don't actually use it for anything?
<flux> you want to chain different types of data?
<flux> which each can be converted to/from a string representation?
<mrvn> There would be some common function that work on type Base that don't touch the data part.
<mrvn> Like write them all out as strings.
<palomer> class type virtual conode = <--what in the world is this beast?
<flux> I think the only working approach is to put in functions to do the operations instead of the actual data, for which the type can vary
<flux> palomer, well, it's the type of a virtual class?-)
jeanb-- has joined #ocaml
jeanb-- has quit [Client Quit]
jeanb-- has joined #ocaml
mwhitney__ has quit [Read error: 110 (Connection timed out)]
<palomer> flux, what does the virtual do?
<flux> palomer, a virtual class requires all methods to be virtual
<flux> and thus it cannot be instantiated
<flux> it must be inherited by another class which has code for the virtual methods
<flux> that class can then be instantiated
<flux> I'm not sure if, given the structural subtyping of classes, virtual classes much make sense in ocaml..
<flux> but I've used them nevertheles :)
<palomer> flux, sure they do!
<flux> atleast it's useful in the context of producing useful error messages
<palomer> structural subtyping doesn't always do the trick
jeanbon has quit [Nick collision from services.]
jeanb-- is now known as jeanbon
<palomer> consider class virtual c = object(_:'self) method get_parent : 'self end
<palomer> consider class virtual c = object(_:'self) method virtual get_parent : 'self end
<palomer> lemme write this example out
<palomer> brb
<palomer> oh my, too early in the morning for this
<palomer> http://pastebin.com/m6d0a1ded <--I don't know if you can do this without virtual classes
<mrvn> Why is the all_to_string not working?
<mrvn> palomer: a class type can do it without virtual, see my paste. But somehow that screws things up
<flux> mrvn, your all_to_string doesn't really try to output anything else but newlines..
<mrvn> ahh, print_string missing. *patsch*
<mrvn> # SDataBase.all_to_string s;;
<mrvn> SDataB::hello
<mrvn> IDataB::23
<mrvn> - : unit = ()
mwhitney__ has joined #ocaml
<flux> mrvn, all well, then?
<mrvn> except that I have to use SDataBase, the specific type of the object. Base.all_to_string s would be nicer.
<mrvn> The public method print_all cannot be hidden
<mrvn> WTF?
<flux> it doesn't match the type 'vbase' anymore
<mrvn> But what is hiding the print_all method?
<flux> the type vbase
<flux> either you make it to be of different type or add the method to vbase
<flux> class type foo = object end class bar : foo = method foo = 42 end --> method foo is not in type foo, thus it is hidden by the type
<mrvn> But vbase has "method print_all : unit"
<flux> hm, right :)
<mrvn> oh, must have forgotten to paste the new vbase class.
<flux> it compiles for me :)
<flux> now that I tried it
<mrvn> # s#print_all;;
<mrvn> SDataB::hello
<mrvn> IDataB::23
<mrvn> That looks much better.
<mrvn> flux: Any idea if I could get the same with module syntax ala "Base.print_all s" somehow?
schme has joined #ocaml
<mrvn> nm, got it.
authentic has quit [Read error: 54 (Connection reset by peer)]
Alpounet has joined #ocaml
<Alpounet> mrvn, sorry for having exited yesterday. Is your problem solved ?
<Alpounet> (Hi all)
<mrvn> Alpounet: I've ended up combining class types and a functor.
<Alpounet> it seems to be a good solution
<mrvn> Having explicit constructors in classes would have been way easier.
<bluestorm> Alpounet: does it not upset you that the rich description of HLVM was written by jdh in his subscription-only "OCaml Journal" ?
<bluestorm> I discovered that recently and got quite frustrated, I'm not sure i'd like to contribute to HLVM unless he makes his documentation freely available
<mrvn> The docs aren't in the source too?
<Alpounet> Hmm ? They are in the sources too, indeed.
<Alpounet> execute ./docs.sh and you'll have a "docs" folder, with ocamldoc generated documentation of hlvm itself, it's type system, etc.
<bluestorm> hm
<bluestorm> The Ocaml Journal article looks like a high-level design discussion rather than an ocamldoc-generated thing
<bluestorm> but perhaps it's in the comments somewhere, I should check that
<bluestorm> (I slightly doubt it though)
<Alpounet> By the way, it seems clear to me that you'll never write an OCaml line for the HLVM project, but it is your choice.
<Alpounet> Moreover, I'll contribute to HLVM because it is an interesting project (for me, at least), and that I'd like to create mine on top of it, that's all.
<Alpounet> bluestorm, the OCaml Journal article may be a high-level design discussion, but you can still learn how to use HLVM without it, quite easily (considering your OCaml experience)
<mrvn> sucks though if thatisn't public and archived.
authentic has joined #ocaml
<bluestorm> Alpounet: I'd prefer everything pertinent to contribute to this project was freely available and not entangled in jdh commercial expectations
<Yoric[DT]> Iirc, that's how jdh makes a living, though.
<Yoric[DT]> So, while it bugs me, I can understand his point.
<Alpounet> Indeeed.
<Alpounet> I prefer people making a living around functional programming stuffs rather than writing trivial Java applications/web services or anything of that kind ...
<bluestorm> I don't mind that, and he stated clearly that he hopes to use HLVM for (proprietary) commercial applications
<bluestorm> he could still make the design description of an open-source project public, imho
<Alpounet> That wouldn't be a bad thing, yes.
<kig> 9^
<mrvn> tomaw: dann musst du es halt mit [cs ]fdisk selber machen
<mrvn> ups
<Yoric[DT]> "halt"?
* Yoric[DT] would have expected an infinitive :)
<Yoric[DT]> Or, well, something else.
<palomer> http://pastebin.com/m6d0a1ded <--I don't know if you can do this without virtual classes
<palomer> whoa
<palomer> sorry
<palomer> I don't know how that happened
<palomer> hrmph
<palomer> inherit doesn't always play nice with types
<palomer> how do I get ocaml to enforce toplevel constraints?
<palomer> like put constraint foo = #foo2 in the toplevel
<palomer> (to simplify type errors)
mwhitney__ has quit [Read error: 131 (Connection reset by peer)]
mwhitney__ has joined #ocaml
verte has quit ["http://coyotos.org/"]
<mfp> heh Fatal error: exception Assert_failure("typing/ctype.ml", 261, 23)
<mfp> class virtual foo = object end type 'a t = 'a constraint 'a = #foo class bar = object(self : _ t) end
<flux> indeed, fails with my 3.11.1 also
<mfp> match ... with Tobject ... -> ... | _ -> assert false
<mfp> but it somehow rejects (self : unit)
<Alpounet> for having Thread module functions in our programs, we just have to link against threads.cma right ?
<mfp> Alpounet: and compile with -thread
<mfp> or just ocamlfind ocamlc -package threads
<Alpounet> thanks
<abtok> so what would be the right way to compile a file.ml with Num ?
<bluestorm> nums.cma iirc
<abtok> i have to copy it in my folder ?
<Alpounet> Hah, Thread.kill not implemented ?
<Alpounet> Invalid_argument("Thread.kill: not implemented")
<Alpounet> looks like a joke
<flux> alpounet, what would you use it for?
<mfp> abtok: ocamlfind ocamlopt -package num -c foo.ml ocamlfind ocamlopt -package -num -o program foo bar baz -linkpkg
<flux> such operations are commonly viewed as being very hazardous
seafood has quit []
<Alpounet> flux, to kill a thread if it takes too much time to finish
<mfp> abtok: or just prepend num.cmxa to the list of modules when linking
<Alpounet> (here, it doesn't matter if it doesn't finish)
<abtok> why two commands ?
<flux> alpounet, is it changing global variables or why does it need to be a thread?
<Alpounet> It doesn't change global variables. It justs execute some code, and I want this thread to be killed if it takes too much time.
<Alpounet> justù
<Alpounet> just*
<flux> you can likely use a process for that
<mfp> abtok: for separate compilation --- if you only have 1 module you can compile & link in one step
<Alpounet> killing processes is implemented ? :-p
<mfp> so either ocamlfind ocamlopt -package num -o foo foo.ml -linkpkg or ocamlopt -o foo nums.cmxa foo.ml
<bluestorm> Unix.signal ?
<flux> alpounet, killing a thread doing anything 'theadworthy' is generally a bad idea. such as, what happens if it's holding a mutex at the time of kill..
<Alpounet> It doesn't.
<flux> resources held by processes on the other get released when they are killed
<mfp> the former makes it easy to use other libs (just do -package a,b,c)
<abtok> ok thanks
<Alpounet> Do I have to look at Extlib/Batteries or such libs for getting thread killing in my ocaml code ? :/
<flux> well, you could try using vmthreads
<flux> if you compile natively
<flux> or use a process :)
<Alpounet> Heh :-)
<Alpounet> Unix module processes, right ?
<bluestorm> Alpounet: imho processes are nicer than threads here
<mrvn> Taking a mutex should generate a abstract value that can eigther be release manually or released by the GC through finalize_*. Then killing a thread would (eventually) free the mutex.
ygrek has joined #ocaml
Morphous has joined #ocaml
Amorphous has quit [Nick collision from services.]
Morphous is now known as Amorphous
ygrek has quit [Remote closed the connection]
ygrek has joined #ocaml
<flux> alpounet, maybe this can be useful for you: http://www.modeemi.cs.tut.fi/~flux/software/ocaml/runUpto.ml
<flux> oh, right
<flux> it doesn't handle the case where the child doesn't terminate properly
<flux> but that's simple, just add Unix.kill before returning with None
<Alpounet> Quite interesting... Thanks !
chahibi has joined #ocaml
<chahibi> Hello
<flux> (fixed the .ml)
<flux> (didn't try it, though)
<chahibi> How can I run Caml light?
<bluestorm> "camllight" ?
<Alpounet> Is it already installed on your system ?
<Alpounet> If it is, see bluestorm's answer.
<chahibi> bluestorm, I am using Debian, there doesn't seem to be a caml light package
<bluestorm> chahibi: do you really need to use caml light instead of OCaml ?
<bluestorm> the answer is probably "No"
<bluestorm> if it isn't, see the INRIA website for the packages
<flux> isn't the only reason to use caml light that you need to use it at school?
<chahibi> bluestorm, Is "type word == char list;;" correct in camllight?
<bluestorm> i suppose
<chahibi> bluestorm, I see in many references the use of == in synonym types
<bluestorm> In caml light, yes
<chahibi> bluestorm, that is why I thought it only works in caml light
<bluestorm> (I just checked and it's correct)
<bluestorm> well
<bluestorm> use "type word = char list" and you've got working OCaml code
<bluestorm> flux: imho, the only reason to use caml light is when you have to _teach_ it at school :-'
<flux> bluestorm, well, I think for each such individual there are dozens of others who need to use it to pass courses :)
<bluestorm> hm
<chahibi> bluestorm, I do not understand why caml light isn't distributed within debian
<bluestorm> chahibi: probably because it's old software wich isn't maintained anymore
<bluestorm> flux: students can use OCaml, the teacher would hardly notice
<bluestorm> doesn't count as real "need"
<flux> bluestorm, so ocaml is sufficiently backward compatible then?
<flux> I'm thinking a scenario where students are tasked with an application to develope and they pass the source for verification
<bluestorm> hm
<bluestorm> I can't pretend I know all the places were Caml Light is still used for teaching
<chahibi> Why doesn't the "ocaml" interpreter allow to skip through the characters?
<bluestorm> but if you're thinking of French Classes Préparatoires, they don't do such things
<flux> I don't know any place, but that's the way it works at our uni's c++ courses :)
<bluestorm> (I mean, ask students to develop real application and try to _compile_ the source code later)
<bluestorm> (I suppose any teacher asking that would be sufficiently motivated and ahead of his time to compile using ocaml instead of caml light)
<mrvn> Usualy you have to demonstrate and explain the code. So you just start ocaml instead of camllight and demonstrate.
<hcarty> chahibi: You can use rlwrap or ledit to gain line editing with the ocaml toplevel
<mrvn> or xemacs
<chahibi> Hadaka, thanks
<chahibi> hcarty, , thanks
sgnb has quit [Remote closed the connection]
sgnb has joined #ocaml
<xian> Excuse my newbie'ish question here, but is there a function which turns a string into a list of its comprising characters? I can't seem to be able to find such a function in the String module.
<kmkaplan> xian: Str.split (Str.regexp "") you_string
<xian> kmkaplan: Thanks. Why isn't this included as a standard function in the String module if I may ask (I guess, people need this rather often)?
<kmkaplan> xian: it is very easy to write a better one. Using Regexp for this and getting a list of strings is kind of kludgy.
<mrvn> let explode str = let rec loop acc = function -1 -> acc | n -> loop (str.[n]::acc) (n-1) in loop [] (String.length str - 1)
<xian> kmkaplan: Yes, it seems so. I mean, why isn't a function explode : string -> char list included in the standard lib?
<mrvn> xian: there should be String.to_list
<mrvn> and String.of_list
<xian> mrvn: I don't seem to have them and they are also not referred to in the documentation: http://caml.inria.fr/pub/docs/manual-ocaml/libref/String.html
<mrvn> no, they don't exist but logically they should.
<flux> lazy man's solution: let explode str = Array.to_list (Array.init (String.length str) (fun i -> str.[i]))
<flux> (I've picked the idea from some of you guys ;))
<flux> but batteries will make it better :)
<mrvn> flux: hehe.
<xian> Okay, thanks for your suggestions.
<mrvn> Would be nice if string and char array where the same.
<mrvn> Or does anything speak against that?
<flux> yeah, actually I wonder why they aren't
<flux> but atleast they really aren't, because Obj.magic segfaults on me :)
<mrvn> char array is an array of values (32/64) bit) each containing a char. 4 times the space.
bluestorm has quit [Read error: 113 (No route to host)]
<mrvn> -)
<xian> mrvn: I don't think so. That's the way it is done in Haskell. There, a string "blah" is merely syntactic sugar for a list of characters.
<flux> well, that explains it then. special casing data structures makes interoperability with C more difficult.
<mrvn> flux: float/double arrays are already special
<flux> xian, which is really nice and elegant. too bad sometimes one also wants effiency :/.
<mrvn> xian: list of chars is bad. A string has random access in ocaml.
<mrvn> A char list would also use 8/16 times the space.
bluestorm has joined #ocaml
bluestorm_ has joined #ocaml
bluestorm_ has quit [Read error: 104 (Connection reset by peer)]
abtok has left #ocaml []
Alpounet has quit ["Ex-Chat"]
Alpounet has joined #ocaml
jeanb-- has joined #ocaml
jeanb-- has quit [Client Quit]
<chahibi> How can I access the nth element of a tuple?
<bluestorm> You have to do it by yourself, using pattern matching
<olegfink> chahibi: tuples have a constant size; see fst and snd in Pervasives.
<flux> chahibi, do note that arrays are a very different thing compared to a tuple
<chahibi> Ok
<Alpounet> doing such a thing might be possible with camlp4, but that would be metaprogramming.
<bluestorm> chahibi: if you have records with a lot of specific fields, you should consider using a record
<bluestorm> (they are basically tuple with named fields)
<chahibi> I have "type something = Leaf of int*char ;; let b = Leaf (1,'a') ;;"
<chahibi> and val first_element : 'a * 'b -> 'a = <fun>
<chahibi> how can I access the first element of b? first_element reports a type problem
<flux> let first_element node = match node with Leaf (a, b) -> a
<chahibi> Error: This expression has type something but is here used with type 'a * 'b
jeanb-- has joined #ocaml
<flux> otherwise written as: let first_element = function Leaf (a, _) -> a
<chahibi> thanks flux
<bluestorm> chahibi: is "Leaf" the only constructor of that type ?
<bluestorm> if it is not, you should generally not use such a partial function
<chahibi> bluestorm, no, I didn't want to detail
<bluestorm> well, if it is a sum type you should do a pattern-matching when you need something, and not in a generic function
<bluestorm> it allows you to handle the failure cases (when the value you're considering is _not_ a Leaf) at use place
<bluestorm> (that's not a hard rule, but it generally leads to nicer code)
<chahibi> What is a sum type? (or perhaps you mean product type, tuple)
<bluestorm> type ('a, 'b) foo = Bar of 'a | Baz of 'b
<bluestorm> that's what I call a "sum type", as the inhabitants of the type are (more or less rigourosly) in the disjoint union of the "Bar" and the "Baz" parts
slash__ has joined #ocaml
jonasb has joined #ocaml
jeremiah has quit [Read error: 104 (Connection reset by peer)]
<chahibi> Thanks
Camarade_Tux_ has joined #ocaml
jeanbon has quit [Read error: 110 (Connection timed out)]
palomer has quit ["Leaving"]
slash_ has quit [Read error: 101 (Network is unreachable)]
jeanb-- is now known as jeanbon
slash__ is now known as slash_
jeremiah has joined #ocaml
jamii_ has quit [Read error: 110 (Connection timed out)]
Camarade_Tux has quit [Read error: 110 (Connection timed out)]
infoe|wk has quit [Read error: 110 (Connection timed out)]
infoe|wk has joined #ocaml
genericplayer has joined #ocaml
<genericplayer> is there a way to work around ocamlbuild thinking its a circular build when your main.ml has an "Open Gmain" in it?
<genericplayer> Gmain having a Main module inside it
<mfp> ping ertai?
<Yoric[DT]> iirc, it's a bug in ocamldep
<Alpounet> "Recursion is the goto of functional programming" haha
<bluestorm> Alpounet: that's not completely false
<Alpounet> yep, the "haha" was because I found it funny :-)
<ygrek> genericplayer, you use Main.something in code?
<genericplayer> yeah
<ygrek> maybe "module NotMain = Gmain.Main" will do?
jamii_ has joined #ocaml
raffaele has joined #ocaml
<raffaele> ciao
jeanb-- has joined #ocaml
jeanbon has quit [Nick collision from services.]
jeanb-- is now known as jeanbon
raffaele has quit [Remote closed the connection]
raffaele has joined #ocaml
raffaele has quit [Remote closed the connection]
Associat0r has joined #ocaml
Associat0r has quit [Read error: 104 (Connection reset by peer)]
<genericplayer> does anyone know what a working ocamlbuild incantation is for a lablgtk2 app off the top of their head?
<Yoric[DT]> Yeaaah.
<Yoric[DT]> Batteries just passed the 1900 downloads mark.
<Camarade_Tux_> \o/
<ygrek> -libs lablgtk2 -cflags -I,+lablgtk2 -lflags -I,+lablgtk2 (like for any other "external" library)
<Alpounet> Cheers !
<Alpounet> We'll organize a party for 2000 (or 2009) downloads !
jeddhaberstro has joined #ocaml
<genericplayer> oh there we go, it's -libs lablgtk but everything else is lablgtk2
hardcoding has joined #ocaml
<hardcoding> Hello! I would like to write a function that returns the value of the nth element of a list, for example: fun(3,[4;7;8;9;6;7]) = 8 can someone help me?
<olegfink> hardcoding: see [List.nth]
<hardcoding> what, it really exists? lol
<hardcoding> is it complicated if I want to write it myself olegfink ?
<olegfink> you can check its source; and no, you can express it by a simple recursion.
<Camarade_Tux_> it's a three-liner
<Camarade_Tux_> maybe a lit bit more /me's brain is damaged by the lack of sleep
<olegfink> haskell-like pattern matching in function definition would make it a bit shorter, but yeah indeed it's very simple.
<bluestorm> hardcoding: it's generally a bad idea to access list elements by indexing, because it's slow and usually denotes a design flaw
<olegfink> bluestorm: iirc it's quite usual to use it together with [iterate] in haskell?
<hardcoding> bluestorm, are you the one I sometimes talk to on sdz? olegfink I see that the profile of the nth function is 'a list -> int -> 'a isn't there a way to write it such as a,list -> int ?
<olegfink> "a,list -> int"?
<hardcoding> yeah olegfink I mean a int* (int list) -> int
<bluestorm> 'a * 'a list -> 'a is more general than int * int list -> int, and it's the exact same code
<bluestorm> ahem, int * 'a list -> 'a
<bluestorm> your code should not depend on the list element's type, hence the 'a
<bluestorm> olegfink: Haskeller sometimes do bad things to keep the feeling that everything is a one-liner
<hardcoding> same thing .... I just wonder why List.nth is written as 'a list -> int -> 'a ...
<olegfink> hardcoding: using tuples for arguments makes your functions uncurriable without buying you anything.
<bluestorm> hardcoding: that's currying, standard way to use arguments in Caml
<bluestorm> let f x y = ... instead of let f (x, y) = ...
<hardcoding> I see thanks
<mrvn> hardcoding: let nth_prime = List.nth [2;3;5;7;11;13;17;19;23]
<mrvn> With tuples you couldn't do that and would have to spell out all the arguments.
<hardcoding> Can someone help me find the source code of List.nth?
<kmkaplan> hardcoding: it's in list.ml
<hardcoding> thanks I found it
<mrvn> 8th hit.
<hardcoding> mrvn, vielen dank mrvn ich hab's schon gefunden lol I found it already
* olegfink doesn't understand http://andrej.com/plzoo/html/poly.html#type_infer.ml :-(
<olegfink> that is, I dont understand why it works without half the things described in Cardelli's paper.
jonasb has quit [Remote closed the connection]
<bluestorm> that code would benefit from a monadic treatment of generated equations
<bluestorm> cnstr ctx e1 >>= fun ty1 -> cstr ctx e2 >>= fun ty2 -> TBool, [ty1,TInt; ty2, TInt]
oriba has joined #ocaml
animist has joined #ocaml
hardcoding has quit ["Leaving"]
<olegfink> ocamlbuild tries to use bash on Nt?
mwhitney__ has quit [Read error: 110 (Connection timed out)]
jeddhaberstro has quit []
<mrvn> I think I need a diff programm to highlight the differences in the module/class/functor interfaces in error messages.
<mrvn> Am I doing something wrong if the error message is longer than the source=
<mrvn> ?
itewsh has joined #ocaml
Mr_Awesome has joined #ocaml
<Alpounet> I think so :-p
* Yoric[DT] does use diff for this kind of things.
<ygrek> olegfink, yes
tomaw has quit [Remote closed the connection]
<ygrek> it work's fine with this one (second hit in google) - http://www.steve.org.uk/Software/bash/ - it is a single binary contrary to cygwin/etc
tomaw has joined #ocaml
itouch has joined #ocaml
mwhitney__ has joined #ocaml
palomer has joined #ocaml
<palomer> hullo
<palomer> how do I put a subtype constraint in a signature?
Associat0r has joined #ocaml
<Yoric[DT]> palomer: I'd go for
<Yoric[DT]> constraint foo#bar
<Yoric[DT]> (I'm not sure, though)
<palomer> you can write that on the toplevel?
oriba has left #ocaml []
<Yoric[DT]> # type 'a t = int constraint 'a = #float;;
<Yoric[DT]> Error: Unbound class float
<Yoric[DT]> (so, syntactically at least, it's correct)
itewsh has quit [Read error: 110 (Connection timed out)]
<palomer> can signatures be recursive?
<Yoric[DT]> I don't think so.
<palomer> hrmph
<palomer> I'm writing a toolkit
<Yoric[DT]> iirc, constraints are only on polymorphic arguments
<Yoric[DT]> So it'd be something like
<Yoric[DT]> type 'a t constraint 'a = #foo
<Yoric[DT]> and implementation
<Yoric[DT]> type 'a t = 'a
<palomer> type 'a t = 'a <--does this even make sense?
<palomer> so constraint in classes is also for polymorphic arguments?
<palomer> I've been using it with 'self !
<Yoric[DT]> Well, I may be missing something.
<palomer> http://pastebin.com/m465d4b61 <--why the blazes do I get this error?
<Alpounet> <palomer> type 'a t = 'a <--does this even make sense? <<< sure, it's a "identical" type transformation
<Alpounet> an*
Snark has quit ["Ex-Chat"]
<mrvn> palomer: it is an extension to have recursive modules.
<mrvn> palomer: module rec A : sig
<mrvn> type t = Leaf of string | Node of ASet.t val compare: t -> t -> int end
<mrvn> and ASet : Set.S with type elt = A.t
<mrvn> for example
seafood has joined #ocaml
ygrek has quit [Remote closed the connection]
<mfp> palomer: the syntax is inherit [int] foom
<mfp> you cannot inherit a type
itouch has quit ["There are only 10 kinds of people: those who understand binary and those who don't"]
<Alpounet> he also could have written "There are only 10 kinds of people: those who use a good programming language and those who don't use OCaml"
hkBst has quit [Read error: 104 (Connection reset by peer)]
<jlouis> that latter is much much better
verte has joined #ocaml
<chahibi> there are three types of people those who know to count and those who don't
<Alpounet> :-)
animist has quit [Remote closed the connection]