cjeris changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/
mikeX has quit ["leaving"]
Mr_Awesome has joined #ocaml
pedro_ has quit [Read error: 113 (No route to host)]
pedro_ has joined #ocaml
bzzbzz has joined #ocaml
dss has joined #ocaml
dss has quit [Remote closed the connection]
twobitsprite has joined #ocaml
<twobitsprite>
is OcamlSDL the most up-to-date SDL interface for ocaml? It seems a bit unmaintained, looks like their last release was in 2005...
<twobitsprite>
is it just that its complete and so no further work is necessary?
pedro__ has joined #ocaml
pedro_soc has joined #ocaml
pedro_ has quit [Read error: 110 (Connection timed out)]
<twobitsprite>
I love how Ocaml has such an active community...
<twobitsprite>
:P
Smerdyakov has quit [Remote closed the connection]
Smerdyakov has joined #ocaml
pedro__ has quit [Read error: 110 (Connection timed out)]
joshcryer has joined #ocaml
Mr_Awesome has quit ["...and the Awesome level drops"]
skal_ has joined #ocaml
skal has quit [Read error: 110 (Connection timed out)]
Smerdyakov has quit ["Leaving"]
<flux>
it might very well be complete :) (disclaimer: I've never used it)
<flux>
oh, right, ocamlsdl
<flux>
I somehow read that as OcamlIDL
pedro_soc has quit [Read error: 113 (No route to host)]
<flux>
yeah, it doesn't appear to be maintained, and it misses features of the most recent SDL
<flux>
personally I've missed some sdlmixer features such as positional sound
<flux>
it wouldn't be a big task to bring it up to date, though..
<flux>
and fix some bugs (which might be in SDL, though: for example segmentation fault when you render string "")
<flux>
hm.. I think the sourceforge cvs was down the last time I tried to check OcamlSDL out, and it now again is..
<mrvn>
Or not. string "" is a special case in ocaml.
Submarine has quit ["Leaving"]
<flux>
mrvn, yeah, but I'm thinking it will probably generate a NULL-surface, which gets wrapped, etc, and things get bad..
<flux>
so it should perhaps create a 1x1 or 0x0 surface, or throw an exception
<mrvn>
It has to allocate 1 byte, write a 0 in it and pass a pointer to that.
<mrvn>
(or a static string)
<flux>
mrvn, so the C interfacing macros don't handle all that?
<flux>
I don't see why empty strings would need to be allocated when sending them to a C-function: referring to a statically allocated "" is surely enough?
z__z has quit [Read error: 104 (Connection reset by peer)]
<mrvn>
preferable as well.
<mrvn>
Are ocaml strngs 0 terminated and one char longer than the usable string?
<mrvn>
Or does the C interface copy the string and 0 terminate it?
<flux>
they are 0-terminated
<flux>
makes a lot of sense, really, when interfacing with C :-)
<flux>
(although ocaml strings can embed 0-characters, which obviously won't work, but I suppose that's a rare problem)
<mrvn>
Except "" which is size 0.
<flux>
String_val appears to use the value directly.. but if it broke on empty strings, it would break all kinds of C-library bindings :-o
<mrvn>
How often do you have ""?
<mrvn>
It might give NULL for "".
<flux>
well, I'm thinking String_val works as specified: String_val(v) returns a pointer to the first byte of the string v, with type char *. This pointer is a valid C string: there is a null character after the last character in the string. However, Caml strings can contain embedded null characters, that will confuse the usual C functions over strings.
<flux>
you could try and prove the documentation wrong ;)
<flux>
but I'm off to office now (in transit for 20 min or so)
<mrvn>
Maybe String_val has a static "" that it returns.
Submarine has joined #ocaml
Submarine has quit [Read error: 104 (Connection reset by peer)]
<flux>
my only ready-made bindings take string, offset and length so they cannot test that (without modification)
pedro_soc has joined #ocaml
<pedro_soc>
hi, im looking the Type inference system, and i found an example that i dont understand. Maybe someone can help me.
<pedro_soc>
let rec eval = function | `Int n -> n | `Add(e1, e2) -> eval e1 + eval e2 | `Mul(e1, e2) -> eval e1 * eval e2;;val eval : ([< `Add of 'a * 'a | `Int of int | `Mul of 'a * 'a ] as 'a) -> int = <fun>
<mrvn>
And your question is?
<pedro_soc>
umm i dont understand the line : ([< `Add of 'a * 'a | `Int of int | `Mul of 'a * 'a ] as 'a) -> int = <fun>
<pedro_soc>
'a is an expression ? but why Add or Mul. ?
<mrvn>
The function is 'a -> int, but 'a can be a subset of `Add of 'a * 'a | `Int
<mrvn>
of int | `Mul of 'a * 'a
<mrvn>
s/can/must/
<mrvn>
That is a recursive type. It contains 'a inside again.
<pedro_soc>
umm, ok i think i get it.
<mrvn>
Think about type expr = Add of expr * expr | Int of int | Mul of expr * expr and then val eval: expr -> int = <fun>
mvanier has joined #ocaml
swater has joined #ocaml
slipstream-- has joined #ocaml
pango_ has quit [Remote closed the connection]
pango_ has joined #ocaml
timmu has joined #ocaml
timmu has left #ocaml []
z__z has joined #ocaml
mvanier has left #ocaml []
pango_- has joined #ocaml
slipstream has quit [Read error: 110 (Connection timed out)]
<flux>
offtopic: can anyone on the other side of The Great Pond resolve/connect to di.fm:80?
benny has joined #ocaml
<mrvn>
;; connection timed out; no servers could be reached
<flux>
I guess steadyhost.com's network connectivity is to blame
<flux>
however even their secondary nameserver is unreachable, which is very bad
<flux>
and judging from their ips (which might be misleading) their primary and secondary dns is in the same subnet! baaad..
pango_ has quit [Remote closed the connection]
pango_- is now known as pango_
benny_ has quit [Read error: 110 (Connection timed out)]
bebui_ has quit ["leaving"]
rickardg has joined #ocaml
benny99 has joined #ocaml
benny99 has left #ocaml []
dark_ has quit [Remote closed the connection]
ouicestmoi has joined #ocaml
<ouicestmoi>
Okay, I am getting an error, when I try to declare a type thus:
<ouicestmoi>
type a' maybe = Just of a' | Nothing;;
<mrvn>
# type 'a maybe = Just of 'a | Nothing;;
<mrvn>
type 'a maybe = Just of 'a | Nothing
<flux>
ouicestmoi, btw, there exists 'a option which is essentially the same
<ouicestmoi>
Okay. Thanks.
<ouicestmoi>
I was putting the ' after. Dunno where the idea came from.
* ouicestmoi
thought, since it is legal in Haskell, it should be legal here. :oD
ouicestmoi has quit [Client Quit]
Hadaka has quit [Read error: 110 (Connection timed out)]
skal__ has joined #ocaml
skal_ has quit [Read error: 110 (Connection timed out)]
cjeris has joined #ocaml
bluestorm_ has joined #ocaml
mikeX has joined #ocaml
pango_ has quit [Remote closed the connection]
swater has quit ["Quat"]
<twobitsprite>
does anyone know of anything like pygame for ocaml?
<twobitsprite>
I know there's ocamlsdl, but pygame is a python wrapper for sdl which provides more sophisticated drawing primitives, like line drawing, etc...
pango_ has joined #ocaml
<twobitsprite>
pango_: you familiar with pygame? know of anything like it for ocaml?
<twobitsprite>
nevermind... I guess I wasn't using good google terms...
<twobitsprite>
I should have guessed it would have been called "MLGame" :P
<bluestorm_>
have you looked on the hump ?
<ppsmimou>
twobitsprite: there's ocaml-sdl for example
<twobitsprite>
ppsmimou: as I said, I found what I was looking for, it's called "MLGame"... thanks though
<pango>
bobl: a.ml or a.cmo or a.cmx (if already compiled a bytecode or native) must be present before b.ml on ocamlc or ocamlopt command line to compile b.ml
<bobl>
pango, hmm i think it is called a.cmxa
<pango>
cmxa is a native compiled library, that should do too
<bobl>
hmm, i see, it matters where the -I dir is in the command
<bobl>
sometimes i get "no implementation present" and sometimes "unbound module a'
<[ElPhIl]>
How can i get only values from a 'a option list ? = [NONE, SOME 1, NONE, SOME 3] to [1, 3]
<pango>
bobl: is a before b ? the order of modules matters too
<bobl>
pango, yes a is before b
<pango>
[ElPhIl]: constructors are None and Some, and list seperator is ;
<[ElPhIl]>
this i know... sorry for giving you the ml exemple... can you still help me to do this?
twobitsprite has quit ["Lost terminal"]
<pango>
[ElPhIl]: there's no simple way
<[ElPhIl]>
no mapPartial in ocaml ?
<pango>
OCaml's standard library has next to nothing predefined for option types
<[ElPhIl]>
man i'm screwed
<tsuyoshi>
that's not hard to do with extlib
<tsuyoshi>
using List.filter iirc
bohanlon has quit [Remote closed the connection]
bobl has quit ["Leaving"]
<tsuyoshi>
hmm.. even without that, it's not too hard
<tsuyoshi>
List.fold_left (fun a b -> match b with Some x -> x::a | None -> a) [] [None, Some 1, None, Some 3];;
<pango>
+ List.rev
<jlouis>
List.fold_right is better no List.rev
<pango>
but not tail-rec, if that matters
<tsuyoshi>
if the list order matters
<tsuyoshi>
I don't think rev is tail recursive either
<pango>
it is
<pango>
List.rev implementation is trivial
<tsuyoshi>
oh ok
<[ElPhIl]>
method secCheck =
<[ElPhIl]>
let laEnv = new secEnv [] in
<[ElPhIl]>
let traitement s = let (a,b) = s#secCheck laEnv in a#iter ~f:(fun ~key ~data -> laEnv#add ~key:key ~data:data);b in
<[ElPhIl]>
let bso = List.map (fun s -> traitement s) self#sort in
<[ElPhIl]>
let bs = List.fold_left (fun a b -> match b with Some x -> x::a | None -> a) [] bso in
<[ElPhIl]>
if (List.length bs = 0) then (laEnv,None) else (laEnv,Some bs)
<[ElPhIl]>
end
<[ElPhIl]>
thank you guys for your help
<[ElPhIl]>
it's working
<pango>
List.length bs = 0 is O(n)
<pango>
use bs = [] instead
<[ElPhIl]>
ok i will i need to get use to ocaml...
[ElPhIl] has quit ["Leaving"]
<pango>
tsuyoshi: one tail-rec implementation of rev: let rev l = List.fold_left (fun a b -> b :: a) [] l
<tsuyoshi>
ow.. my brain hurts trying to read that
<tsuyoshi>
oh wait.. I see
<tsuyoshi>
I guess that should be obvious
<mrvn>
'if (List.length bs = 0) then (laEnv,None) else (laEnv,Some bs)' should realy be '(laEnv, bs)'.
<mrvn>
tsuyoshi: let list_rev = let rec helper acc = function [] -> acc | x::xs -> helper (x::acc) xs in helper []
<pango>
yes, [] looks empty enough to me, too
<mrvn>
plus you can just List.iter handle_event bs on it.
<pango>
idiomatic ocaml code would probably require only half the number of lines...
<tsuyoshi>
yeah.. I'm having a hard time figuring out what the goal is
<tsuyoshi>
hmm
<tsuyoshi>
well the second line should be more like
<tsuyoshi>
hmm wait a second
benny has quit ["leaving"]
<tsuyoshi>
let bs = ExtList.List.filter_map (fun s -> let (a, b) = s#secCheck laEnv in a#iter laEnv#add; b) self#sort in
<tsuyoshi>
that could replace the middle three lines
swater has quit [Read error: 110 (Connection timed out)]
swater has joined #ocaml
* pango
smells handmade OO reimplementation of lists and hash tables/maps)
* tsuyoshi
smells schoolwork!
benny has joined #ocaml
skal_ has joined #ocaml
* mrvn
smells like he needs a shower.
skal__ has quit [Read error: 110 (Connection timed out)]
<hcarty>
I'm extracting a Bigarray from a value with a variant type, and actions on the extracted Bigarray are very slow compared to a raw Bigarray
<hcarty>
Is this normal? Does a performance hit from variant types carry along with everything touched by it/them?
<hcarty>
I'm in the middle of moving a library over to using variant types containing various Bigarray types rather than the user having to define and pass in a Bigarray
<hcarty>
The result seems to be killing performance in untouched code, so I'm a little concerned by this
<Nutssh>
Which kind of variant types?
<Nutssh>
Can you pastbot a bit of sample code?
<hcarty>
Sure, I'll make a small example and put it on a paste site
<hcarty>
The "do_something" function takes orders of magnitude longer with x coming from a variant type than it does with a Bigarray created and passed in directly
rickardg has quit [Remote closed the connection]
pango has quit [Remote closed the connection]
swater has quit ["Quat"]
pango has joined #ocaml
mikeX has quit ["leaving"]
pedro_soc has quit [Read error: 104 (Connection reset by peer)]
pedro_soc has joined #ocaml
Naked has joined #ocaml
Naked is now known as Hadaka
cjeris has quit [Read error: 104 (Connection reset by peer)]