Alpounet changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | 3.11.1 out now! Get yours from http://caml.inria.fr/ocaml/release.html - Answer OCaml Meeting 2010 poll https://forge.ocamlcore.org/survey/survey.php?group_id=77&survey_id=1
ikaros has quit ["Leave the magic to Houdini"]
travisbrady has joined #ocaml
micrun has joined #ocaml
onigiri has joined #ocaml
caligula_ has joined #ocaml
peddie_ has joined #ocaml
verte has joined #ocaml
verte is now known as verte-work
caligula__ has quit [Read error: 110 (Connection timed out)]
peddie has quit [Read error: 113 (No route to host)]
dh_ has joined #ocaml
<dh_> does anyone know how to patch up an old caml program that wants 32-bit integers but seems to be getting 31-bit integers?
<orbitz> sounds like an odd situation...
<dh_> indeed
<dh_> but, it gets Uncaught exception: Failure("int_of_string") on 0x7fffffff and accepts 0x3fffffff
<orbitz> does that work elsewherE?
<dh_> it worked in ~1998
<dh_> (it is Benjamin Pierce's Pict compiler
<dh_> )
<orbitz> hrm i get -1 in mine
rwmjones_lptp has quit ["This computer has gone to sleep"]
<dh_> it could be some other problem entirely that's feeding junk to int_of_string
<dh_> but I don't think so and the compiler passes its basic test suite
<orbitz> indeed
<dh_> I have not really waded into the compiler because it's not entirely trivial and I don't have much experience with ocaml, but it *looks* like it's just passing the lexer result to int_of_string
<dh_> | '-'?['0'-'9']+
<dh_> { Parser.INTV{i=info lexbuf; v=int_of_string (text lexbuf)} }
<dh_> (the actual input text is 2147483647, not 0x7fffffff)
<dh_> clearly one bit is being used as a tag; so I guess the question is how to get a full-width integer
tmaeda is now known as tmaedaZ
tmaedaZ is now known as tmaeda
tmaeda is now known as tmaedaZ
<ccasin> dh_: The standard library provides the module Int32 with 32 bit integers
<ccasin> of course, if you're using other library functions that expect regular ints, changing could be an arbitrary amount of work
<dh_> yeah, I know :-/
<ccasin> yeah, this is a major hassle with ocaml
cmeme has quit [Read error: 110 (Connection timed out)]
<dh_> oh, and since ocaml doesn't have typeclasses it'll mean changing all arithmetic around too
<dh_> bleh
onigiri has quit []
<mfp> dh_: IIRC the int_of_string fix is new in 3.12, so you can just look for the corresponding commit & revert it
<mfp> assuming that the overflow is not a problem, of course
<dh_> hmm?
<mfp> otherwise, the easiest workaround would be to compile on a 64-bit platform and use 63-bit arithmetic...
<dh_> I'm using 3.11.1
<dh_> that's an idea though
<mfp> hmm "- PR#4210, #4245: stricter range checking in string->integer conversion functions (int_of_string, Int32.of_string, Int64.of_string, Nativeint.of_string). The decimal string corresponding to max_int + 1 is no longer accepted."
<mfp> that's only for 0x4000000 though
<mfp> oops 0x40000000
<mfp> # int_of_string "1073741824";; - : int = -1073741824
<mfp> but # int_of_string "1073741825";; Exception: Failure "int_of_string".
<mfp> in 3.11.1
BigJ2 has joined #ocaml
<thelema> Say I need every big of performance I can get - is there a reasonable way to use 0x00000000 as None instead of a proper option?
<thelema> s/big/bit/
eldragon has left #ocaml []
<mfp> thelema: what is '_a in your '_a option?
<thelema> int Dllist.node_t
ccasin has quit ["Leaving"]
<thelema> doesn't have to be 0x00000000, can be 0x00000001 to play nice with GC
<mfp> yes, it should work
<thelema> Is there a good way to keep from shooting myself in the foot using the type system?
<mfp> hmmm, a phantom type
<mfp> or just an abstract type in fact
<thelema> hide it in a module? hmmm... type 'a nullable let get x = x let set x = ...
<thelema> hmm, I'm putting all these values in arrays...
<mfp> module S : sig type t val null : t val access : t -> int Dllist.node_t end = struct type t = int Dllist.node_t let null = Obj.magic 0 let access x = if Obj.magic x = 0 then failwith "None" else x end
<mfp> oh, and val some : int Dllist.node_t -> t .... let some x = x
<thelema> hmm, would it be possible to generalize this?
<dh_> grr, why doesn't Int32 have greater/less functions?
<dh_> it's annoying enough without having to use compare
<mfp> thelema: module S(T : sig type t end) : sig type t val none : T.t ... end = ...
seanmcl has quit []
<thelema> mfp: functors would kill the performance.
* thelema hopes there's some performance gain
<mfp> thelema: no, it's just a type-level thing in this case
<mfp> note that you never call a function in T
<thelema> only functions accessed through functors... aha
<mfp> I mean, I don't see how it could.
<thelema> dh_: let int32_lessthan x y = -1 = Pervasives.compare x y
* thelema will try both
<thelema> once he has enough infrastructure to test. Thanks for the idea.
<mfp> thelema: the assembly looks OK
<thelema> excellent. I've also added an unchecked_access function so I can drop the checks once I'm happy that it's not going to blow up
<mfp> given module Opt(...) module O = Opt(struct type t = string end),
<mfp> calling O.access is just mov ..., %eax jmp camlOpt__access_65
<thelema> grr, want to force inlining...
<mfp> and camlOpt__access_65 is cmpl $1, %eax jne .L101 ..... .L101: ret
<mfp> hah, hadn't compiled with -inline 100
<mfp> it's now cmpl $1, %eax jne .L110 ... code to raise exn if None ... .L110: .... if is Some ...
* thelema wonders why the ocaml compiler insists on keeping control of inlining to itself
<thelema> while it doesn't take control of anything else - preferring to do exactly what the programmer asks of it.
verte-work has quit [Remote closed the connection]
tmaedaZ is now known as tmaeda
verte-work has joined #ocaml
<thelema> nice.
* thelema is making an *extremely* efficient undirected graph library
monestri has quit [Remote closed the connection]
<dh_> thelema: YM "Int32.compare x y", but it doesn't help much to let-bind it in place
<dh_> anyway
<thelema> you can bind it to (<) if you like.
seanmcl has joined #ocaml
<thelema> hmm, I'm having wierd results with batteries' bitset - when I create_full, I get a bitset that's half empty. Every other bit!
verte-work is now known as verte
verte is now known as verte-work
Amorphous has quit [Read error: 110 (Connection timed out)]
Amorphous has joined #ocaml
<dh_> thelema: can you? I didn't think ocaml allowed ad hoc polymorphism
<thelema> dh_: that's not polymorphism - that's rebinding an identifier
<thelema> let (<) x y = x - y in 3 < 1
travisbrady has quit []
<dh_> bleh
<dh_> that's not much use either
<dh_> anyway, I hacked it up, 560 line patch
<dh_> at least sort of works.
<dh_> enough to go on for now
<dh_> (and to send upstream)
<dh_> anyway, thanks
_unK has quit [Remote closed the connection]
dh_ has left #ocaml []
valross has joined #ocaml
seanmcl has quit []
travisbrady has joined #ocaml
tmaeda is now known as tmaedaZ
tmaedaZ is now known as tmaeda
thrasibule has joined #ocaml
caligula__ has joined #ocaml
caligula_ has quit [Read error: 110 (Connection timed out)]
Mr_Awesome has joined #ocaml
thrasibule has quit [Read error: 110 (Connection timed out)]
_zack has joined #ocaml
ulfdoz has joined #ocaml
tmaeda has quit [Read error: 60 (Operation timed out)]
micrun has quit [Read error: 113 (No route to host)]
tmaeda has joined #ocaml
ulfdoz has quit [Read error: 60 (Operation timed out)]
kaustuv_ has joined #ocaml
<flux> soo, has anyone tried implementing PMap in terms Map in 3.12 just as a proof of concept?-)
kaustuv_` has quit [Read error: 110 (Connection timed out)]
Associat0r has quit []
mishok13 has joined #ocaml
ttamttam has joined #ocaml
verte-work has quit ["~~~ Crash in JIT!"]
yurug has quit ["KVIrc Insomnia 4.0.0, revision: , sources date: 20090115, built on: 2009/03/07 02:39:30 UTC http://www.kvirc.net/"]
ikaros has joined #ocaml
peddie_ has quit [Read error: 60 (Operation timed out)]
munga has joined #ocaml
peddie has joined #ocaml
verte has joined #ocaml
julm has joined #ocaml
ikaros has quit [Read error: 110 (Connection timed out)]
ikaros has joined #ocaml
_zack has quit ["Leaving."]
_zack has joined #ocaml
|Jedai| is now known as Jedai
<Camarade_Tux> argh, I don't know if I can support C variable arguments in ocaml-gir
<rwmjones> ha ha ... python is so lame ... http://code.google.com/p/python-bitstring/
<verte> rwmjones: just looks like duplication of the standard library's struct module to me
<Camarade_Tux> rwmjones: he :P
<Camarade_Tux> but they have a pretty logo :)
<rwmjones> compare it to ocaml bitstring (or erlang bitstring for that matter)
<flux> ocaml-bitstring cannot read streams :(, but so it appears that doesn't either
<rwmjones> 'course, being python, it'll also be incredibly slow
<flux> I can imagine bitshuffling not being terffibly fast
<gildor> rwmjones: i'm working on ocaml-gettext, fixing bugs for next release
<gildor> rwmjones: you'll get some surprise with this new version
<rwmjones> cool ... I have at least one which I haven't mentioned
<rwmjones> surprise in a good way or a bad way?
<gildor> very good way
<gildor> and for free ;-)
<rwmjones> gildor, anyhow, one thing is that our translators keep adding bogus "Plural-Forms" lines to the po files, and ocaml-gettext barfs on those
<rwmjones> and then we have to add patches to remove those lines, eg: http://cvs.fedoraproject.org/viewvc/devel/virt-top/virt-top-1.0.3-bogus-zh_CN-plurals.patch?view=markup
<gildor> I was working on this yesterday night
<rwmjones> ah ok, I forgot that I submitted that one ...
<gildor> I need to find the list of "sane default"
<gildor> for plural forms
ikaros has quit [Remote closed the connection]
tmaeda is now known as tmaedaZ
tmaedaZ is now known as tmaeda
tmaeda is now known as tmaedaZ
tmaedaZ is now known as tmaeda
<mfp> flux: I don't think you can, because of the "locally bound module name M escapes its scope" problem
<mfp> let singleton (type a) (x : a) = let module M = Set.Make(struct type t = a let compare = compare end) in M.singleton x;;
<mfp> oh, it might possible using first-class modules
_andre has joined #ocaml
rwmjones has quit [Read error: 110 (Connection timed out)]
<flux> mfp, does that singleton work?
<mfp> flux: no, you get the "locally bound module name M escapes its scope" error
<flux> actually what I originally meant that atleast it may be possible to have let create (type a) () : a = let module M = Set.Make(struct type t = a let compare = compare end) in { find = fun a b -> M.find a b; etc } ?
<flux> (and implement a module on top of that. so, implement PMap in terms of Map, without copying the Map implementatino to do it)
<mfp> that'd work, yes
<mfp> but you'll need to encode existential types using polymorphic records or a first-class module to implement add
<mfp> at some point you need to store a _ M.t in the record, but M cannot escape the scope
rwmjones has joined #ocaml
tmaeda is now known as tmaedaZ
antegallya has joined #ocaml
BigJ2 has quit [Read error: 110 (Connection timed out)]
antegallya has quit [Client Quit]
munga has quit [Read error: 60 (Operation timed out)]
mehdid has quit [wolfe.freenode.net irc.freenode.net]
mehdid has joined #ocaml
<Camarade_Tux> does anyone have a time machine? I need to know at compile-time something I can only know at runtime :)
nimred has quit ["leaving"]
bzzbzz has joined #ocaml
nimred has joined #ocaml
c0m has quit [Read error: 104 (Connection reset by peer)]
Associat0r has joined #ocaml
<julm> Camarade_Tux: think again :P
_zack has quit ["Leaving."]
<Camarade_Tux> he, I'd like to :P
BiDOrD has quit [Read error: 110 (Connection timed out)]
BiDOrD has joined #ocaml
valross has quit ["Ex-Chat"]
verte has quit ["~~~ Crash in JIT!"]
julm has quit [Remote closed the connection]
julm has joined #ocaml
atol has joined #ocaml
<atol> Hi
<atol> Hmmm what is mod in the sentence "if i mod 2 = 1 then"
<Camarade_Tux> modulo
<Camarade_Tux> C's %
<atol> But modulo 2 = 1 ?
<Camarade_Tux> tests: (i mod 2) = 1
<atol> oh ok
tmaedaZ is now known as tmaeda
<atol> Thx u, it's hard to understant without ( and ) :D
<atol> understand*
<Camarade_Tux> he ;p
<flux> mfp, could you replace singleton with something like val create : (unit -> 'a) -> 'a t, where the function would only serve as a container to the type? (and it wouldn't actually be called)
<flux> something like: create (fun () -> (assert false : int)) - not that pretty, though :)
<flux> mfp, anyway, seems to be quite nice feature
willb1 has joined #ocaml
tmaeda has quit [Read error: 60 (Operation timed out)]
Alpounet has joined #ocaml
tmaeda has joined #ocaml
BigJ2 has joined #ocaml
seanmcl has joined #ocaml
<thelema> wow - this is the first time I've had a program where caml_page_table_lookup takes 10% of cpu time
<Camarade_Tux> isn't it more likely since 3.11?
<thelema> stupid address space randomization...
* Camarade_Tux has that deactivated actually
<flux> and it's a kludge mainly for patching security-as-an-afterthought into software written in C :/
willb1 has quit [Remote closed the connection]
<thelema> hmm, has anyone used -inline with ocamlbuild + ocamlfind?
<Camarade_Tux> what would be the difference compared to just ocamlopt?
_unK has joined #ocaml
alp_ has joined #ocaml
Alpounet has quit [Read error: 113 (No route to host)]
nimred has quit ["leaving"]
nimred has joined #ocaml
Associat0r has quit []
<atol> Hmmm, just for curiosity im testing the factorielle i ocaml. But it's quicly too long number for float or int. Is there other thing than float or int to manipulate number ?
<atol> in*
nimred has quit ["leaving"]
nimred has joined #ocaml
nimred has quit [Client Quit]
<mfp> atol: Int64 and Num/Big_int
<atol> Can i use Int64_of_int ?
<atol> And how i multiply 2 int64 each other ?
<atol> Like a float ?
nimred has joined #ocaml
<atol> nobody ?
<ttamttam> Int64 module defines operators to operate on int64 http://caml.inria.fr/pub/docs/manual-ocaml/libref/Int64.html
<flux> and with pa_do it might be actually convenient to use
<atol> Thx for your help. But im too much beginning for use module. Im gonna continue my learning to this part and use this :D
<atol> pa_do ? another module ?
<thelema> Camarade_Tux: when I use camlbuild to produce foo.p.native, it runs ocamlc to build foo.cmo
Alpounet has joined #ocaml
alp_ has quit [Read error: 54 (Connection reset by peer)]
<thelema> atol: pa_do is a syntax extension that makes this kind of thing easier
<thelema> ah, there's an inline tag for .cmx files
<mfp> flux: easy, let empty (type a) ?(compare = compare) () = let module PS = struct type element = a module S = Set.Make(struct type t = a let compare = compare end) type t = S.t let s = S.empty end in (module PS : PS with type element = a);;
<flux> ah, of course, compare will help
<mfp> empty ();; -> (module PS with type element = '_a) = <module>
<flux> doesn't that actually give us better type-safety than pmaps usually?
<flux> in the case when two pmaps interact with each other?
<mfp> it's no diff from normal PMaps
<flux> mfp, so if you create two modules of int, are their t's compatible?
<flux> mfp, I'm thinking functions like Map.S.equal
<mfp> equal needs to be implemented inside the inner module
<mfp> hmm
<mfp> equal seems impossible
<mfp> since we're using existential types, and there's no way to indicate that the inner types must be identical
<mfp> à la applicative functors
<mfp> I'd need something like let module PS2 = (val t2 : PS with type element = a and module S = PS1.S) in
hugin has quit [Client Quit]
hyperboreean has quit [Read error: 113 (No route to host)]
_unK has quit [Remote closed the connection]
hugin has joined #ocaml
BigJ2 has quit []
thelema has quit [Read error: 104 (Connection reset by peer)]
thelema has joined #ocaml
_unK has joined #ocaml
kaustuv_` has joined #ocaml
kaustuv_ has quit [Read error: 110 (Connection timed out)]
travisbrady has quit []
ikaros has joined #ocaml
_unK has quit [Remote closed the connection]
_unK has joined #ocaml
albacker has joined #ocaml
travisbrady has joined #ocaml
bluestorm has joined #ocaml
bluestorm has quit [Client Quit]
mishok13 has quit [wolfe.freenode.net irc.freenode.net]
mishok13 has joined #ocaml
seanmcl has quit []
smimou has joined #ocaml
mishok13 has quit [Connection timed out]
ttamttam has quit ["Leaving."]
albacker has quit ["Leaving"]
drunK_ has joined #ocaml
ulfdoz has joined #ocaml
hcarty has quit ["leaving"]
hcarty_phone has joined #ocaml
_unK has quit [Read error: 110 (Connection timed out)]
_zack has joined #ocaml
h3r3tic has quit [Read error: 104 (Connection reset by peer)]
h3r3tic has joined #ocaml
ttamttam has joined #ocaml
Submarine has joined #ocaml
julm has quit [Read error: 113 (No route to host)]
julm has joined #ocaml
julm_ has joined #ocaml
drunK_ has quit [Client Quit]
_unK has joined #ocaml
julm_ has quit [Client Quit]
julm has quit ["leaving"]
julm has joined #ocaml
bzzbzz has quit ["leaving"]
Associat0r has joined #ocaml
_andre has quit ["leaving"]
ttamttam has quit [Read error: 104 (Connection reset by peer)]
ttamttam has joined #ocaml
rwmjones_lptp has joined #ocaml
_zack has quit [Read error: 110 (Connection timed out)]
sramsay_ has joined #ocaml
Asmadeus has quit [Read error: 104 (Connection reset by peer)]
ygrek has joined #ocaml
hcarty has joined #ocaml
hcarty_phone has quit []
Asmadeus has joined #ocaml
julm has quit ["ododo"]
ulfdoz has quit [Read error: 145 (Connection timed out)]
<Camarade_Tux> bah, I'm completely stuck, I can *not* add support for functions using variable arguments to ocaml-gir =/
ygrek has quit [Remote closed the connection]
ttamttam has quit ["Leaving."]
onigiri has joined #ocaml
ofaurax has joined #ocaml
hyperboreean has joined #ocaml
ofaurax has quit ["Leaving"]
<palomer> I'm sure someone has encountered this problem before
<Camarade_Tux> libffi could have helped but it doesn't actually support varargs
<Camarade_Tux> actually a gcc commiter told me there was no solution
slash_ has joined #ocaml
eldragon has joined #ocaml
munga has joined #ocaml
Ched has quit [Read error: 60 (Operation timed out)]
ched_ has joined #ocaml