<mrvn>
Is there some way to get that #as_widget part implicitly?
<mrvn>
Something to tell or make ocaml realize they all have a common base class that should be used.
<adrien_>
Array.map (fun w -> w#as_widget) [| ... |] ?
zpe has quit [Remote host closed the connection]
<adrien_>
I don't hink you can make ocaml "guess" it should use the common base class
<adrien_>
maybe with :> but you'd have as much typing
<adrien_>
(but in this case, I'm wondering what you're going to do with this array afterwards)
<mrvn>
Create a Grid.t with it, which takes an 2D array of widgets to layout.
zpe has joined #ocaml
<mrvn>
adrien_: I can't ise Array.map (fun w -> w#as_widget) [| ... |]: Error: This expression has type Gui.Grid.t but an expression was expected of type Gui.Image.t The first object type has no method foo
<adrien_>
hah, right, stupid me :P
<mrvn>
It works if all classes have only the same methods.
dextrey has joined #ocaml
<mrvn>
let (widgets : Gui.Widget.t array array) = [| [| image; |]; [| grid; |]; |] could tell ocaml to cast to Widget.t implizitly. :(
zpe has quit [Remote host closed the connection]
Yoric has joined #ocaml
osnr has joined #ocaml
osnr has quit [Read error: Connection reset by peer]
<mrvn>
hmm, I've run into a small inconvenience. I'm using _oasis. I have my source in ./ and I build a packed module gui from stuff in gui/. This causes "-I gui" to get added to the command line during build and then Gui.Widget.t and Widget.t are both valid but are taken as different types.
<adrien_>
iirc I had to avoid letting ocamlbuild peek inside my "pack" directories while building
<adrien_>
and only let it see the result of each packing
<adrien_>
which is why I removed some of the "include" directives in the _tags file
<mrvn>
By using Path: . you get the pack to be build directly in _build and then you don't need the -I pack anymore, right?
<adrien_>
"maybe" :P
<adrien_>
it's been more than one year since I touched this
<adrien_>
(I was waiting for runtime type information)
<mrvn>
Now this is odd. I did that change and I get a ./gui.mlpack file and _build/gui/* are build but no _build/gui.*
<adrien_>
I think that at some point I pondered building everything separately, install with ocamlfind locally and then use ocamlfind for the last stage
<adrien_>
because that was quite tricky to get right
<mrvn>
E: Failure("No one of expected built files '_build/gui.cmi' exists")
<mrvn>
It build _build/gui/gui.cmi though
<mrvn>
Ok, maybe my fault. I have to delete gui/gui.mlpack
zpe has joined #ocaml
<mrvn>
Tada. now it works. tanks.
<mrvn>
thanks.
<adrien_>
\o/
<adrien_>
you have a clean commit showing what you had to do?
<mrvn>
well, too early. It builds but the problem remains.
<adrien_>
:D
<adrien_>
13:41 adrien_ : I had to do some patching too: 52 sed -e '/include/ d' _tags > tags_0
<mrvn>
It now implicitly adds -I gui. Before I had to explicitly list that as BuildDepend
<mrvn>
I have no include in _tags
<mrvn>
I have includes = [("", ["gui"])]; in myocamlbuild. How did that get there?
<adrien_>
no clue; tried regenerating everything from scratch?
<mrvn>
deleted it, oasis setup, still includes gui.
Enjolras has quit [Quit: Màj de libiconv]
ollehar has quit [Ping timeout: 260 seconds]
ollehar has joined #ocaml
ollehar1 has joined #ocaml
Yoric has quit [Ping timeout: 246 seconds]
ttamttam1 has quit [Ping timeout: 246 seconds]
ollehar has quit [Ping timeout: 240 seconds]
ttamttam1 has joined #ocaml
zpe has quit [Remote host closed the connection]
gustav_ has joined #ocaml
gnuvince has quit [Ping timeout: 260 seconds]
introom has quit [Remote host closed the connection]
Drup has joined #ocaml
introom has joined #ocaml
tobiasBora has joined #ocaml
<tobiasBora>
Hello,
<tobiasBora>
I'd like to save a Stream I made with the ogg vorbis library in a file but I don't really know how to do it. The exemples I saw use old functions...
<mrvn>
Ok, figured it out now: 1) the library needs PATH: . so the pack is created in _build instead of _build/gui, 2) I need to list gui in BuildDepends or the required libs aren't linked in, 3) I need to use InternalModules: gui/Widget otherwise oasis adds -I gui (thorugh myocamlbuild.ml).
zpe has joined #ocaml
<adrien_>
heh :-)
<mrvn>
and I need to ignore "W: No exported module defined for library gui"
<mrvn>
Still seems like a bug that it adds -I gui for the pack when I use Modules instead of InterlaModules.
<adrien_>
I don't think I had that one but I haven't updated in some time
<adrien_>
hmm, curious, when did you become +o? I'm asking because the channel has an additional annoying setting which restricts the ability to +o people
<mrvn>
14:47 -!- mode/#ocaml [+o mrvn] by ChanServ
<mrvn>
just now when I identified with nickserv
zpe has quit [Remote host closed the connection]
<mrvn>
adrien_: your myocamlbuild.ml doesn't have the extra includes. Must be my oasis doing that.
<mrvn>
OASIS v0.3.0 (C) 2009-2010 OCamlCore SARL
csakatoku has quit [Remote host closed the connection]
<bernardofpc>
how can I use Set.Make in toplevel ? #use ? #require ?
<mrvn>
should just work
<bernardofpc>
Error: Unbound constructor Set.Make
<pippijn>
bernardofpc: how are you using it?
<bernardofpc>
oh
<mrvn>
# module M = Set.Make;;
<bernardofpc>
let s = Set.Make int ;;
<pippijn>
bernardofpc: bad
<pippijn>
module M = Set.Make(Int);;
<pippijn>
but you need an Int module
<pippijn>
with stuff in it
<pippijn>
try:
<pippijn>
module M = Set.Make(String);;
<bernardofpc>
then s = M {"test"} ?
<mrvn>
module M = Set.Make(String) is probably the easiest way to test it.
<bernardofpc>
how do I construct a value of type M
<bernardofpc>
?
<pippijn>
M.empty
<pippijn>
M.add "test" M.empty
<bernardofpc>
ok
<bernardofpc>
then if I want ints, how do I do ?
<pippijn>
you can use batteries' BatInt module
<pippijn>
or make your own
<bernardofpc>
ok
<pippijn>
module M = Set.Make(struct type t = int let compare a b = b - a end);;
<bernardofpc>
compare = compare should work ?
<Drup>
yes
<pippijn>
yes
<bernardofpc>
ok, thks !
<mrvn>
I recommend opening an editor and typing stuff there and then cut&paste it into the toplevel to test or compile the file.
<pippijn>
I recommend using rlwrap
introom has quit [Remote host closed the connection]
<ggole>
a - b is only a valid comparison for most values of a and b, btw
ollehar1 has joined #ocaml
<ggole>
Better to use let compare (int:a) b = compare a b
introom has joined #ocaml
<ggole>
Er, (a:int). Bleh.
osnr has joined #ocaml
osnr has quit [Changing host]
osnr has joined #ocaml
ollehar has quit [Ping timeout: 245 seconds]
xavierm02 has joined #ocaml
<xavierm02>
hey
<xavierm02>
could someone explain me this:
<xavierm02>
val print : ?first:string -> ?last:string -> ?sep:string -> ('a Extlib.InnerIO.output -> 'b -> unit) -> 'a Extlib.InnerIO.output -> 'b t -> unit
<xavierm02>
in ocaml batteries
<xavierm02>
like the two last things
<xavierm02>
what do the ('a o -> 'b -> unit) and the 'a o -> 'b t -> unit represent?
<xavierm02>
anything explaining the basics of how io is built would do
osnr has quit [Ping timeout: 256 seconds]
<mrvn>
placeholders
<Drup>
not sure "placeholders" is the right way to name this
<xavierm02>
could you please detail?
<mrvn>
xavierm02: print works with any type. But the types of the pretty-printer, the outout channel and value you want to print have to match.
<xavierm02>
ah
<xavierm02>
I know what the 'a are
<xavierm02>
I don't know what I should give to this specific function
<mrvn>
If you want to know what Extlib.InnerIO.output is then you need to read the Extlib docs / source.
<xavierm02>
because I could build a function having that type
<xavierm02>
but it would probably not be the expected function
<Drup>
xavierm02: basicaly, t is a container with some 'a value in it, so to print 'a t, you have to provide a printing function for 'a (it's the ('a Extlib.InnerIO.output -> 'b -> unit)) and a channel (Extlib.InnerIO.output)
<Drup>
to protive the printing function for 'a, you can look inside other Batteries module
<Drup>
for exemple, the function "print : Extlib.InnerIO.output -> int -> unit" is provided in the BatInt module
<xavierm02>
ok
<Drup>
huh, I messed up between Batteries and Extlib, but you get it
<xavierm02>
in fact my problem is that I want to get the string representing a PSet and that it only has printf, no sprintf...
<xavierm02>
let str = IO.output_string () in PSet.print str s; close_out str
<xavierm02>
I would've expected it to work that way
<xavierm02>
but that's not the proper use of print
<xavierm02>
so what do I put as ('a Extlib.InnerIO.output -> 'b -> unit)?
<mrvn>
if 'a is a FooBar then FooBar.print
breakds has joined #ocaml
<xavierm02>
but the print I'm calling is PSet.print...
<xavierm02>
I give him itself as argument? That's weird...
<mrvn>
which seem to need a pretty-printer for the contained thing
<Drup>
xavierm02: what's inside the set ?
<xavierm02>
I don't know
<mrvn>
xavierm02: The 'a is the 'a in 'a PSet.t
<xavierm02>
'a things
<mrvn>
you need a prtty-printer for the 'a
<Drup>
xavierm02: you need to know in order to print it :)
<xavierm02>
but a could be anything :o
<xavierm02>
'a*
<xavierm02>
I have a string_of_element function
<xavierm02>
but that's 'a -> string
<xavierm02>
I'll just go see how they did the pretty prints
<xavierm02>
printers
<mrvn>
xavierm02: if you don't know what the 'a is then you have to take the pretty-printer as additional argument from whoever gives you the Pset to print
<xavierm02>
Yes. I have a 'a -> string function. I'll see if I can transform it into a pretty printer.
zpe has joined #ocaml
Arsenik has quit [Remote host closed the connection]
<bernardofpc>
pippijn: mrvn thks
zpe has quit [Ping timeout: 264 seconds]
<samebchase>
companion_cube: https://pastee.org/z3cpt sequence is nice. Thanks for the recommendation. :-)
<xavierm02>
i got it working
<xavierm02>
thank you :)
zpe has joined #ocaml
zpe has quit [Remote host closed the connection]
csakatoku has joined #ocaml
ollehar has joined #ocaml
csakatoku has quit [Ping timeout: 246 seconds]
ollehar has quit [Ping timeout: 240 seconds]
<introom>
what does the 'val' inside 'val x: int = 3' mean? value?
<xavierm02>
yes
osnr has joined #ocaml
osnr has quit [Changing host]
osnr has joined #ocaml
<adrien_>
it's a keyword which indicates the declaration of a variable
<adrien_>
which can be used in signatures
mye has joined #ocaml
<xavierm02>
val printf : ('a, 'b Extlib.InnerIO.output, unit) t -> 'a
gnuvince has joined #ocaml
<xavierm02>
val sprintf : ('a, unit, string) t -> 'a
<xavierm02>
is there a simple way to transform a printf call into a sprintf one?
osnr has quit [Ping timeout: 246 seconds]
<xavierm02>
nm i used fprint f
<xavierm02>
strange that there isn't a function just like fprintf that returns a string instead of writing to the screen
csakatoku has joined #ocaml
dsheets has quit [Ping timeout: 246 seconds]
ttamttam1 has quit [Quit: ttamttam1]
introom has quit [Remote host closed the connection]
ollehar1 has quit [Ping timeout: 245 seconds]
osnr has joined #ocaml
csakatoku has quit [Remote host closed the connection]
osnr has quit [Changing host]
osnr has joined #ocaml
f[x] has joined #ocaml
zozol has joined #ocaml
beckerb has quit [Quit: Konversation terminated!]
mattrepl has joined #ocaml
ulfdoz has joined #ocaml
csakatoku has joined #ocaml
mattrepl has quit [Quit: mattrepl]
csakatoku has quit [Ping timeout: 256 seconds]
osnr has quit [Quit: Leaving.]
Yoric has joined #ocaml
Yoric has quit [Ping timeout: 246 seconds]
ollehar has joined #ocaml
osnr has joined #ocaml
osnr has quit [Changing host]
osnr has joined #ocaml
xavierm02 has quit [Remote host closed the connection]
ollehar has quit [Ping timeout: 256 seconds]
f[x] has quit [Ping timeout: 276 seconds]
osnr has quit [Quit: Leaving.]
zozol has quit [Quit: irc2go]
ulfdoz has quit [Ping timeout: 248 seconds]
osa1_ has quit [Ping timeout: 276 seconds]
tobiasBora has quit [Ping timeout: 260 seconds]
Anarchos has joined #ocaml
<Anarchos>
how to configure ocamlbuild to link with .o files (where are defined external ocaml functions)
<mrvn>
ever used oasis?
<Anarchos>
nopr
<Anarchos>
nope
ollehar has joined #ocaml
ulfdoz has joined #ocaml
<mrvn>
Anarchos: might be worth a look.
<Anarchos>
mrvn i don't think that oasis has been ported to HaikuOS :/
<mrvn>
I builds you a myocamlbuild.ml for you from a few simple lines describing what you need.
<adrien_>
Anarchos: there's no need to port anything
<Anarchos>
oh i can write my own myocamlbuild.ml ?
<adrien_>
no
<mrvn>
Anarchos: Its ocaml and doesn't have many dependencies
<adrien_>
well, you could but it's going to be ugly
<adrien_>
use oasis
<mrvn>
Anarchos: Oasis writes myocamlbuild.ml for you. You can append to it but normaly you don't need to.
<mrvn>
And you only need to run oasis once. You could run it on linux and then copy the files to haikuOS for building
<mrvn>
For simple things you only need the header and an Executable stanza.
travisbrady has joined #ocaml
mye has quit [Quit: mye]
wwilly has quit [Quit: Leaving]
<mrvn>
type x = Foo of t and class t = object end;;
<mrvn>
How do I write that correctly?
<mrvn>
type x = Foo of t and class t = object (self) method foo = Foo (self :>t) end;; to be more precise
<flux>
type x = Foo of < foo : x > class t = object (self) method foo = Foo (self :>t) end;;
<flux>
a more general solution: type 'a x' = Foo of 'a class t = object (self : 'a) method foo = Foo (self :> 'a) end type x = t x'
<flux>
possibly an even more general solution would involve recursive modules and be quite verbose..
<mrvn>
flux: thx. The first is horribly repetitive and then I need to do every change in places (2 in the .ml file, 2 in the .mli). :(
ulfdoz has quit [Ping timeout: 276 seconds]
<mrvn>
recursive modules are probably realy verbose. :)
<companion_cube>
samebchase: glad to hear it :)
<flux>
mrvn, polymorphic variants might be of use as well here..
<companion_cube>
btw there is an infix version of int_range
<mrvn>
`Foo?
<flux>
sure
<mrvn>
That might actualy make more sense. type 'a recursion = Go_lower | Done | Go_deeper of 'a
<mrvn>
The main loop calls a helper function in each object that tells it what to do next. The helper function could return only a subset of the 'a recursion type.
travisbrady has quit [Quit: travisbrady]
<samebchase>
companion_cube: ah. cool.
<mrvn>
Another solution: exception Go_lower class t = object method foo = raise Go_lower end exception Go_deeper of t
<mrvn>
I think that works better for me. Go_lower is thrown when the mouse moved outside of a widget and Go_deeper only in container widgets when the mouse entered a sub widget. The container can then use "super#mouse_moved x y" without extra code to check if the mouse moved out of it.
walter has quit [Quit: This computer has gone to sleep]
csakatoku has joined #ocaml
contempt has quit [Ping timeout: 240 seconds]
travisbrady has joined #ocaml
tane has quit [Quit: Verlassend]
alang has quit [Ping timeout: 245 seconds]
breakds has quit [Remote host closed the connection]
contempt has joined #ocaml
csakatoku has quit [Ping timeout: 245 seconds]
ulfdoz has joined #ocaml
osnr has joined #ocaml
osnr has quit [Changing host]
osnr has joined #ocaml
osnr has quit [Client Quit]
osnr has joined #ocaml
osnr has quit [Changing host]
osnr has joined #ocaml
osnr has quit [Ping timeout: 246 seconds]
darkf has quit [Quit: Leaving]
osnr has joined #ocaml
osnr has quit [Changing host]
osnr has joined #ocaml
travisbrady has quit [Quit: travisbrady]
osnr has quit [Quit: Leaving.]
ollehar has quit [Ping timeout: 264 seconds]
csakatoku has joined #ocaml
csakatoku has quit [Ping timeout: 245 seconds]
tane has joined #ocaml
csakatoku has joined #ocaml
osnr has joined #ocaml
osnr has quit [Changing host]
osnr has joined #ocaml
osnr has quit [Ping timeout: 245 seconds]
<mrvn>
fun ?(follow=false) ?(lower=wnop) ?(deeper=wnop) fn fail ->
<mrvn>
Can one write this shorter? method private call_active : 'a . ?follow:bool -> ?lower:(Widget.t -> unit) -> ?deeper:(Widget.t -> unit) -> (Widget.t -> 'a) -> (unit -> 'a) -> 'a = fun ?(follow=false) ?(lower=wnop) ?(deeper=wnop) fn fail -> ...
<adrien_>
I don't think so but I don't see it as an issue either
<adrien_>
optional arguments make it easy to have a single function to do the work of several functions
<adrien_>
but if you make it too compact, you lose readability
dezzy has quit [Quit: leaving]
<adrien_>
I think that as soon as I get more than one line to apply a function with labelled arguments, I'll switch to one argument per line
<mrvn>
adrien_: The problem I have is having to specify all the types just to make it polymorphic
<mrvn>
adrien_: I do that in the call. Not in the declaration yet. I probably should.
<adrien_>
I understand but it's something I try to not care about nowadays (even though I still want to make things short)