<edwin>
Error: The record field label dwarf_lang belongs to the type tag_compileunit but is mixed here with labels of type tag_subprogram
<edwin>
and I get that
<edwin>
I could maybe create some objects for those that have common fields
<edwin>
and inherit
<edwin>
but I'd need to write get_/set_ methods to actually read/write the fields, right?
<edwin>
hmm or I could just rename the fields so they don't conflict
<adrien>
yeah, if you don't need inheritance or other object-only features, it's probably a bad idea to use objects
<adrien>
yeah, that too
<edwin>
but why do I get the error when I try to use the type, I expected it to give me an error when I define them
<adrien>
it silently shadows when you define them
<edwin>
is that by design?
<adrien>
if you had a record with a field named "a" in module M, then in module N, you: open M, and define a record with a field named "a", you're effectively shadowing the first type but you don't really want to error on that
<edwin>
or should I file a bug?
<adrien>
now, I wouldn't mind more warnings when shadowing occurs
<edwin>
hmm but in this case I was definining both types in same module
<adrien>
(but it's also complicated because you often write: let l = List.filter pred l in let l = ... l in ..., which should trigger a warning too then)
lamawithonel_ has quit [Ping timeout: 264 seconds]
avsm has quit [Quit: Leaving.]
oriba has joined #ocaml
Snark has joined #ocaml
NaCl is now known as SpanishInquisitr
SpanishInquisitr is now known as NaCl
ftrvxmtrx has quit [Remote host closed the connection]
ftrvxmtrx has joined #ocaml
drunK has joined #ocaml
ygrek has quit [Ping timeout: 240 seconds]
ftrvxmtrx has quit [Remote host closed the connection]
ftrvxmtrx has joined #ocaml
joewilliams_away is now known as joewilliams
oriba has quit [Quit: Verlassend]
lamawithonel has joined #ocaml
lamawithonel__ has quit [Ping timeout: 264 seconds]
ygrek has joined #ocaml
jonafan_ is now known as jonafan
WonTu has joined #ocaml
WonTu has left #ocaml []
kerneis_ is now known as kerneis
unkanon-work has joined #ocaml
<unkanon-work>
does anybody here work for jane street?
yezariaely has joined #ocaml
joewilliams is now known as joewilliams_away
joewilliams_away is now known as joewilliams
ftrvxmtrx has quit [Quit: Leaving]
banisterfiend has quit [Ping timeout: 264 seconds]
ezyang has joined #ocaml
<ezyang>
Is is it better to Math.float_to_int (x .+. 1) or Math.float_to_int (Math.ceil x)?
<ezyang>
Also, no function composition operator? Shocked I say!
<thelema>
ezyang: let (|-) f g x = g (f x)
<ezyang>
Well, the lack of something like that built in tells me that OCaml developers frown on pointless code, so I guess I'll avoid it.
<ezyang>
hmm, I have to store an array of hash functions, which are all the same code parametrized on two ints. Should I store int * int or int -> int (from a partially applied int -> int -> int -> int)
<thelema>
ezyang: as to ciel, probably float_to_int, although where're you getting "Math."?
<ezyang>
thelema: Aren't those functions from the Math module?
<thelema>
Pervasives
<ezyang>
float_to_int floors.
<ezyang>
ah.
<ezyang>
classy.
<thelema>
as to an array of hash functions, depends on what you need to optimize, and if you'll ever have a hash function that's not the (int->int->int->int) base
<thelema>
I guess if I were doing it, I'd spend the tiny bit of extra memory and partially apply your hash function and store the (int -> int) in the hashtable
<thelema>
or array or list or whatever
<unkanon-work>
function composition is essential
Yoric has quit [Quit: Yoric]
<unkanon-work>
you don't need to go all the way and write in pointless notation just because you're composing functions
<unkanon-work>
I'd say use it :)
<ezyang>
is |- what people classically use? Can I use . ? :-)
<thelema>
ezyang: I don't think you can use .
<adrien>
tested: syntax error
<unkanon-work>
aww :(
<thelema>
ezyang: |- is what batteries uses. Since it's not in stdlib, there's a number of independently created namings
<thelema>
hopefully the ocaml world can standardize on something
<ezyang>
having side-effects is... so weird 8-)
<thelema>
batteries uses |- so it can also use -| as f(g x)
<thelema>
ezyang: it's so convenient, though
<thelema>
maybe the authors of ocaml thought it better to be explicit in combining functions
<unkanon-work>
what's the explicit way of composing functions?
<unkanon-work>
oh you said combining, sorry
<unkanon-work>
scheme uses ((compose - abs) -4)
<thelema>
I meant composing, and that's to do [let f = ... in let g = ... in let g_f x = g (f x) in ...
<unkanon-work>
I like it because it looks even cleaner than using (.)
<thelema>
((-) |- abs) -4
<thelema>
but point-free isn't as nice in ocaml. how about: -4 |> abs |> (~-)
<thelema>
or just plain -(abs (-4))
<thelema>
I like |> better, and occasionally use |- in instances like: List.iter (comp |- ignore) foo
<thelema>
Or here's another good one: Array.enum dfa.qs |> map (get_map |- Optimizers.raz_dec |- Vect.length) |> Enum.reduce (+)
ftrvxmtrx has joined #ocaml
<adrien>
an issue with readability is that you lose variable names
<thelema>
true - less code sometimes = less explanation of what's going on
al-maisan is now known as almaisan-away
banisterfiend has joined #ocaml
Pepe_ has quit [Remote host closed the connection]
banisterfiend has quit [Ping timeout: 246 seconds]
<ezyang>
What's the preferred way to do a base-2 logarithm (which will be rounded to an int)?
<thelema>
(* returns the minimum number of bits to represent a value *)
<thelema>
let rec bits_v v = if v = 0 then 0 else 1 + bits_v (v lsr 1)
<ezyang>
I did something like that in Haskell once. It was awfully slow.
<thelema>
that's my code
<thelema>
how big a value are you taking the log of?
<ezyang>
int size
<thelema>
2^64?
groves has quit [Quit: groves]
<ezyang>
sure, if you're on a 64-bit platform
<edwin>
there's another algo to calculate it, see fxtbook.pdf page 28
<hcarty>
ezyang: ; is a sort of half-way compromise between let _ = and let () =
unkanon-work is now known as rien
<hcarty>
ezyang: "let _ =" ignores any return value; "let () =" will give a type error at compile time if the return type isn't unit; "...;" will give a warning if the return type isn't unit
<hcarty>
ezyang: With the extra gotcha that "...;" can not be used at the top level
<ezyang>
thelema: The distribution will still be fine.
<ezyang>
hcarty: Savvy.
<thelema>
ezyang: well, it does raise an invalid_arg exception on my 64-bit ocaml, as the argument to Random.int has to be less than 0x3FFFFFFF
<ezyang>
huh, really
<thelema>
and I can't reproduce the overflow because of that, so I can't confirm my intuition that the overflow can leave you with a negative number. If you're fine with negative numbers...
<ezyang>
Well, I want my code to work with 64-bit too (even though it doesn't, presently)
<thelema>
Random.int64?
<thelema>
or use multiple Random.bits() to construct one 64-bit integer
<ezyang>
thelema: that returns an int64, not an int
<ezyang>
man, why doesn't the native int machinery "just work"
<ezyang>
Oh, I guess the random number machinery doesn't generate negative numbers. That could be problematic from a distribution point of view. Hmmm
<hcarty>
ezyang: You can use "Sys.word_size - 1"
<hcarty>
For your definition of int_size
<hcarty>
And "Random.int ((max_int / 2) * 2) + 1"
<ezyang>
hcarty: Isn't the number of cannabilized bits implementation dependent?
<thelema>
ezyang: maximizing compatibility between 32 and 64-bit ocaml
<hcarty>
ezyang: Yes, though at this point it is 1 for every implementation.
<thelema>
and it's unlikely to change
<hcarty>
thelema: Indeed
<ezyang>
Ok, now I have to convince myself the lack of negative numbers is not a problem.
<thelema>
ezyang: if you need negative numbers, use one more bit of randomness to negate your value
<ezyang>
thelema: That slightly skews the distribution though?
<thelema>
yes, it'd be nice if it overflowed nicely
<thelema>
there's the same number of positive odds as there is negative odds
<thelema>
if you wanted even numbers, there'd be a skew
<ezyang>
oh right!
<ezyang>
classy :-)
<thelema>
:)
<ezyang>
oh, wait
_andre has quit [Quit: leaving]
<ezyang>
ok, so I have to do little more legwork for 64-bit
<ezyang>
because I need 63 bits of randomness, not just 31
<thelema>
yes, you'll have to bit-cobble together 3 random.bits()
<thelema>
note, you only get 30 bits of entropy per Random.int call.
<ezyang>
That code has a subtle skew: lsl wraps around
groovy2shoes has joined #ocaml
<ezyang>
oh, maybe that's just undefined behavior speaking
<thelema>
well, the lsl 60 is unspecified on 32-bit ocaml, but it doesn't run there
<thelema>
# Printf.printf "%x" (0xffff lsl 60);;
<thelema>
7000000000000000- : unit = ()
<ezyang>
yep
<ezyang>
Next step: What do OCamlers like for testing?
<thelema>
OUnit is the best framework we've got
<adrien>
testing? what's that? :P
<thelema>
but many people insist that if it compiles, it must be correct :P
<adrien>
I was actually telling a friend yesterday that when I have a bug in my code, have to change something, I go \o/ before even running trying to run the program :p
<hcarty>
thelema: For some definitions of correct :-)
<ezyang>
Yeah. I've never attempted to test a probabilistic algorithm before.
<ezyang>
Not sure how I'm going to go about doing it.
<thelema>
use probability: many trials, compute confidence intervals, etc
Snark has quit [Quit: Ex-Chat]
<thelema>
well, maybe a simple failure probability is enough
<ezyang>
need to check both epsilon and delta
banisterfiend has joined #ocaml
<thelema>
plot failure probability for various values of epsilon and delta and make sure those curves match theoretical
<ezyang>
what do Ocamlers use to plot?
<thelema>
lately, I've been making quick plots with "graph", part of gnu plotutils
<hcarty>
ezyang: PLplot has OCaml bindings as well
<hcarty>
Which are in the process of being improved...
<flux>
ezyang, I've used Cairo
<ezyang>
k, will look.
<flux>
it's not a plotting library, so it doesn't have that kind of stuff built-in
<ezyang>
Thank you all! gotta run and get dinner.
jcaose has quit [Remote host closed the connection]
banisterfiend has quit [Read error: Connection reset by peer]
banisterfiend has joined #ocaml
banisterfiend has quit [Ping timeout: 240 seconds]
LeNsTR has joined #ocaml
LeNsTR has quit [Read error: Connection reset by peer]
LeNsTR has joined #ocaml
yezariaely has left #ocaml []
jsk has quit [Remote host closed the connection]
jsk has joined #ocaml
jsk has left #ocaml []
ulfdoz has quit [Ping timeout: 264 seconds]
smerz has joined #ocaml
jonrafkind has joined #ocaml
<jonrafkind>
can I put a `module' in a let? let blah = 2 in module type Foo ... ?
<jonrafkind>
oh let module
<adrien>
it might not do what you want: what do you want to do exactly? (won't say more, gotta work)
<jonrafkind>
to isntantiate a module signature locally
<thelema>
jonrafkind: consider functors, if you want to produce a module based on some values
<jonrafkind>
i dont think i need to parameterize on values just yet
<jonrafkind>
ok another quick question, i have two module signatures, module A type x; module B ... method blah : A.x -> unit; but it says A.x is not a cosntructor
<thelema>
there's no module A to refer to, if A is just a signature
<jonrafkind>
so I have to parameterize B over some instantiation of A ?
<jonrafkind>
both modules are signatures
<jonrafkind>
oh module A: Asig; now I can do A.x maybe
<thelema>
module type A = sig type x end module type B = sig type x ... method blah : x -> unit end
<thelema>
module A : A = struct type x = int end module B : B with type x = A.x = struct type x = A.x ... end
<thelema>
module Aimp : A = struct type x = int end module Bimp : B with type x = Aimp.x = struct type x = Aimp.x ... end
<jonrafkind>
ok
<jonrafkind>
so I have to instantiate Bimp with some Aimp, but I want to instantiate Bimp and pass in some arbitrary Aimp later
<jonrafkind>
should I use some other construct besides modules to do that?
<jonrafkind>
I thought I could pass in some module that implemented the A signature
<thelema>
you want Bimp to be a functor?
<jonrafkind>
im not really sure, id ont know a lot about functors yet
<jonrafkind>
ok functors look reasonable but once I instantiate a functor with some module I am stuck with that
<jonrafkind>
really all I want is to define an interface for a class and it looked like signatures were the only way to do that
groovy2shoes has quit [Quit: groovy2shoes]
<thelema>
don't think too much in terms of interfaces - ocaml's object system doesn't need them as much as other languages'
LeNsTR has quit [Read error: Connection reset by peer]
<thelema>
and signatures definitely aren't the right way to do this - if you really want something corresponding to signatures, just define an class with all virtual methods
<jonrafkind>
oh I see, yes maybe thats what I want
<jonrafkind>
so a virtual method is a method thats completely abstract right?
<thelema>
yes, no implementation
<jonrafkind>
its funny that ocaml uses 'virtual' to mean something completely different from c++ and java (although its not a keyword in java)
<jonrafkind>
or at least virtual = pure virtual
<jonrafkind>
can I declare a class inside a let?
edwin has quit [Remote host closed the connection]
<thelema>
of course
<thelema>
you can even do let in between class and object
ygrek has quit [Ping timeout: 240 seconds]
caligula_ has quit [Remote host closed the connection]