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_>
(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.
<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)]
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 ?
<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)]