middayc_ has quit [Read error: 104 (Connection reset by peer)]
jeanbon has quit ["EOF"]
julm has quit [Connection timed out]
julm has joined #ocaml
pantsd has quit [Read error: 60 (Operation timed out)]
pantsd has joined #ocaml
ched_ has joined #ocaml
Ched has quit [Read error: 110 (Connection timed out)]
<alexyk>
I'm still trying to get ocamlmklib to work on Linux/Opteron; same line works on Mac OSX, but CentOS asked to recompile C functions with -fPIC. Did that, now the complaint is: relocation R_X86_64_32 against `a local symbol' can not be used when making a shared object; recompile with -fPIC. ??
<alexyk>
OK that's solved -- needed to -fPIC some hiding ones
<palomer>
:P
<alexyk>
palomer: yeah, that's why I love Scala these days :P
<alexyk>
move a jar anywhere it works
* palomer
has never tried scala
<palomer>
isn't scala old school?
<thelema>
palomer: no, I think it's a pretty new functional language that runs in the JVM
<thelema>
scheme is kinda old
<thelema>
not quite lisp old, but older than scala
<palomer>
I was thinking of the precursor to haskell...
<ccasin>
miranda?
<palomer>
yeah!
<palomer>
hrmph, I developed an algorithm for GADTs, but I don't know the first thing about publishing it
<ccasin>
honestly it will probably be tough - there have been a ton of papers about inference for gadts
<ccasin>
but your best bet is probably to read them
<thelema>
palomer: is your algorithm efficient?
<palomer>
yes
<palomer>
very
<palomer>
and efficient
<palomer>
with easy error messages
* thelema
guesses it has some flaw
<palomer>
of course
<palomer>
it doesn't try very hard to infer
<palomer>
so if you want to use GADTs, you'll probably have to annotate the first argument of the match and the return of the match
<palomer>
but if you don't use GADTs, it behaves exactly like hindley milner
<palomer>
it's cool because it's extremely easy to implement
<palomer>
and forcing the user to annotate when he wants to use GADTs isn't that much of a deal
<palomer>
ccasin, I did my masters on GADTs. I find all the papers incomprehensible (which is one of the reasons I developed this system)
<ccasin>
palomer: fair enough, but if you hope to get your thing published you'll have to do a detailed comparison of it with the well known papers
<thelema>
palomer: some gadts don't need annotations?
<palomer>
if the inference engine infers a specific enough type for the guard and the output, then you don't need it
<palomer>
ccasin, well, the gist of it is that my algorithm is strictly less powerful. However, it's better because of the easier error messages
<palomer>
(I don't understand Haskell's GADT error messages)
<palomer>
and my system doesn't rely on new kinds of type variables
<palomer>
(see rigid types)
<palomer>
type 'a term = (IntLit : int -> int term) | (BoolLit : bool -> bool term)
<thelema>
palomer: yes, but it's important to be able to explain to the user exactly when annotations are needed.
<palomer>
let eval : forall y. y term -> y = function IntLit x -> x | BoolLit x -> x <---this typechecks
<palomer>
thelema, yeah, my algorithm is good for that
<palomer>
there's a very simple way to explain to the users when they need annotations
<ccasin>
right, one of the chief claims of some of the recent gadt papers is that they do inference _and_ have a convincing story for the user about where annotations are needed
<palomer>
mine is better than convincing, it's rather trivial
<ccasin>
:)
<palomer>
and I don't see the point of writing a super complicated algorithm to save a few programmers from writing some annotations
r0bby is now known as r0bby|arr
<palomer>
so evil type checks, but let eval' = function IntLit x -> x | BoolLit x -> x doesn't type check
r0bby|arr is now known as r0bby
<palomer>
I've written down every single rule of my system, comes out to 5 pages. Hindley milner would probably come out to 4
ccasin has quit ["Leaving"]
maxote has quit [Read error: 60 (Operation timed out)]
maxote has joined #ocaml
<brendan>
Error: The file /sw/lib/ocaml/site-lib/findlib/findlib_top.cma is not a bytecode object file
<brendan>
clue?
<brendan>
I get this with ocamlfind ocamlmktop -o toploop -package pcre,findlib -linkpkg
<brendan>
also with #use "topfind";; in the top level
<brendan>
nm, needed to rebuild findlib against 3.11.1
jeddhaberstro has quit []
<palomer>
I remember there being a way of getting around the value restriction
<palomer>
with obj.magic
pizza__ has joined #ocaml
Camarade_Tux has joined #ocaml
pizza_ has quit [Read error: 110 (Connection timed out)]
yziquel has joined #ocaml
yziquel has left #ocaml []
eevar2 has joined #ocaml
ched_ is now known as Ched
Lomono_ has joined #ocaml
Lomono has quit [Read error: 60 (Operation timed out)]
_zack has joined #ocaml
Yoric[DT] has joined #ocaml
Snark has joined #ocaml
verte has joined #ocaml
Yoric[DT] has quit ["Ex-Chat"]
hkBst has joined #ocaml
Yoric[DT] has joined #ocaml
jeanbon has joined #ocaml
Camarade_Tux has quit [Read error: 104 (Connection reset by peer)]
Camarade_Tux has joined #ocaml
Associat0r has quit []
julm has quit [Read error: 110 (Connection timed out)]
julm has joined #ocaml
Lomono_ has quit ["Don't even think about saying Candlejack or else you wi"]
verte has quit [Read error: 110 (Connection timed out)]
verte has joined #ocaml
Lomono has joined #ocaml
youscef has joined #ocaml
Amorphous has quit [Read error: 104 (Connection reset by peer)]
Amorphous has joined #ocaml
Spiwack has joined #ocaml
_zack has quit ["Leaving."]
authentic has quit [Read error: 110 (Connection timed out)]
Ppjet6 is now known as Pepe_
ertai has quit [Read error: 104 (Connection reset by peer)]
pizza__ has quit [Read error: 110 (Connection timed out)]
sporkmonger has quit []
ertai has joined #ocaml
dabd has joined #ocaml
Yoric[DT] has quit [Read error: 110 (Connection timed out)]
sporkmonger has joined #ocaml
ertai has quit ["Lost terminal"]
verte has quit [Read error: 110 (Connection timed out)]
verte has joined #ocaml
sugalo has joined #ocaml
<sugalo>
hi ; why can ocaml only create arrays of length ~4,000,000 ? is it possible to remove this limitation ?
authentic has joined #ocaml
<sugalo>
i guess changing max_array_length in sys.ml is not really safe ?
<mfp>
sugalo: the runtime uses a 1-word header, which holds info for the GC (color & block size)
<mfp>
on 32-bits, there are only 22 bits for the block size
<sugalo>
oh ok hence the formula for max_array_length
<mfp>
yup
<sugalo>
so what will happen if i change manually this integer ?
<mfp>
there's no way around this really: if you need more than 2^22-1 elements on a 32-bit arch, you have to either use a bigarray (for numerics) or a custom structure with nested arrays
<mfp>
sugalo: that won't allow you to create larger arrays
<sugalo>
and can't i make it use 64-bit words ?
<mfp>
that's what happens on 64-bit archs
<mfp>
are you on x86_64?
<mfp>
-> Sys.max_array_length is 18014398509481983
<sugalo>
mfp: i'm not sure
<mfp>
you have a 32-bit OCaml build, that much is certain
<mfp>
but you might be able to build a 32-bit OCaml, depending on your platform
<mfp>
I mean a 64-bit one
<thelema>
sugalo: if you do somehow manage to create an array > max_array_length, the runtime will mangle it in unhappy ways.
<thelema>
likely dropping other data in the space after Array.length mod max_array_length
<thelema>
yes, that's the recommendation. use a Bigarray
<thelema>
it allows big arrays even on 32-bit platform
<thelema>
OCaml was designed on a 64-bit platform, and backported to 32-bit
<mfp>
sugalo: 2 Qs: what OS are you using, and which type of elements will you be placing in the array? If they're numeric, Bigarray will do, both on 32- and 64-bit builds.
<sugalo>
mfp: ubuntu 9.04 ; and i just want integers in my array
<thelema>
mfp: most people wanting huge arrays don't need complex structures in them. And if they did need such, one might be able to cheat with pointer conversion.
<sugalo>
and why is Bitv unknown when i use the toplevel ? even though i've entered #use "bitv.ml" ?
<mfp>
if you #use it, it's as if you'd typed the code, so there's no Bitv module, all the functions are defined at the top level
ccasin has joined #ocaml
<sugalo>
so how can i 'Open' it is the top level ?
<mfp>
if you ocamlc -c bitv.ml and then #load "bitv.cmo";; you'll get the Bitv module
<mfp>
with #use, just refer to the functions directly
<sugalo>
yes thanks
ccasin has quit ["Leaving"]
ccasin has joined #ocaml
Toshakins has joined #ocaml
Toshakins has left #ocaml []
sporkmonger has quit [Read error: 60 (Operation timed out)]
<Camarade_Tux>
btw, just for the heads up, I had bugged the channel with a memory problem when using arrays, the mem used seemed to be twice what it should : http://caml.inria.fr/mantis/view.php?id=4773
<Camarade_Tux>
(imho a comment in the documentation would already be a quite good solution)
<mrvn>
Don't you also have twice the memory use because the array exists in the minor heap and the major heap while it compacts?
<Camarade_Tux>
iirc there is a bump during compaction but I don't know how big it is
* Camarade_Tux
has to run, bbs
<mrvn>
It should use ~386MB ram temporarily I think. The array, the overallocated heap and the major heap it copies the array to.
<mfp>
if the array is large enough (more than 256 words or so), it'll never be in the minor heap
<mfp>
array, overallocated heap and major heap?
<mfp>
aren't there only 2 copies when compacting, the array in the major heap, and the destination array being copied to?
<mrvn>
mfp: yes, but the heap gets grown to 256MB if you use 128MB already.
<mrvn>
mfp: anticipating that you will use more memory in the near future.
<mfp>
I see
<mrvn>
And is it realy that way that anything >256 words goes to the major heap directly? That sounds kind of small for arrays.
<mfp>
#define Max_young_wosize 256
sporkmonger has joined #ocaml
<mfp>
config.h and alloc.c
sporkmonger_ has joined #ocaml
Associat0r has joined #ocaml
sporkmonger has quit [Read error: 113 (No route to host)]
eevar2 has quit ["This computer has gone to sleep"]
mishok13 has quit ["Stopping IRC chat... [OK]"]
verte has quit [Read error: 110 (Connection timed out)]
pants1 has joined #ocaml
ulfdoz has joined #ocaml
Asmadeus has joined #ocaml
pantsd has quit [Read error: 110 (Connection timed out)]
sugalo has quit [Remote closed the connection]
<julm>
palomer: couldn't you use {let buffer : [> ] option ref = ref None} for your copy&paste machinery?
Associat0r has quit []
<palomer>
julm, value restriction
<palomer>
here's the error message:
<palomer>
This pattern matches values of type [> `Bar of 'a ] option
<palomer>
but is here used to match values of type [> `Bar | `Foo ] option
break has left #ocaml []
<mrvn>
You can't have `Bar with different arguments
<mrvn>
palomer: Some `Bar doesn't seem to match Some (`Bar x)
<julm>
palomer: {`Bar} is an integer (hash of "Bar") and {`Bar of ..} is a block whose first field is an integer (hash of "Bar")
<mrvn>
# let _ = buffer := Some (`bar 1.0);;
<mrvn>
- : unit = ()
<mrvn>
# let _ = match !buffer with Some (`Bar x) -> Printf.printf "x = %d\n" x | _ -> ();;
<palomer>
mrvn, it doesn't, but I just wanted to check if it crashes
<mrvn>
- : unit = ()
<mrvn>
Even with 2 blocks it somehow doesn't match.
<palomer>
mrvn, your first bar isn't capitalized
<mrvn>
ups.
<mrvn>
x = 69834128764552
<mrvn>
there you go. type violation.
<palomer>
right
<palomer>
but if you stick to variants
<palomer>
I plan to encode my values as variants, and then put them in the buffer
<mrvn>
The problem is the let buffer : 'a = Obj.magic (ref None)
<palomer>
so `Bar 5 would get encoded as `Variant (`Bar (`Integer 5 ))
<palomer>
but there doesn't seem to be a problem...it seems to work
<mrvn>
As long as you don't mix different types of `Bar
<mrvn>
And without Obj.magic ocaml shouldn't let you.
<palomer>
well, I plan to mix `Bars with different arities
_andre has joined #ocaml
<palomer>
I'm using camlp4 to automatically serialize my values
<palomer>
sticking it in the buffer using an encoding which uses variants
<palomer>
and then writing code to unserialize
<mrvn>
palomer: I think you need to define `Bar0, `Bar1 of 'a, `Bar2 of `a*`a, ...
<palomer>
so you can't mix arities...
<palomer>
any example?
<mrvn>
or just use a existing (safe) marshaling module
<mrvn>
palomer: you already pasted an error of one
<palomer>
did I?
<palomer>
where?
<mrvn>
18:33 < palomer> This pattern matches values of type [> `Bar of 'a ] option
<mrvn>
18:33 < palomer> but is here used to match values of type [> `Bar | `Foo ] option
Associat0r has quit []
<palomer>
oh, that's when I try julm's suggestion
<palomer>
of changing the 'a to a [>] option ref
<palomer>
if I stick to 'a, it works
<palomer>
however, it surprises me that it works
<mrvn>
palomer: but then you need Obj.magic.
<palomer>
I'm using Obj.magic
<mrvn>
and that disables the type checking the way you defined your buffer:'a
<palomer>
it doesn't work without Obj.magic, ocaml refuses to generalize the variables
<mrvn>
exactly.
<palomer>
no matter what I do, I need Obj.magic
<mrvn>
No. you can use a marshal module
<mrvn>
or different `xxx values depending on arity.
<palomer>
with this design, changing the name of the labels depending on the arity doesn't fix the obj.magic problem
<palomer>
is it possible to load a value with marshal safely?
<palomer>
a lot of type information is lost through marshal
<mrvn>
palomer: not with the standard marshal.
<palomer>
there's another marshal?
<mrvn>
yesterday someone pasted a link
<palomer>
does it come with ocaml?
<mrvn>
nope
<palomer>
does it use type-conv?
<mrvn>
maybe batteries has a safe marshal
<palomer>
but anyways, my solution seems to work, except I have to be careful about how I use buffer
<palomer>
and given that I only use buffer in generated code, it doesn't seem to be a problem
<mrvn>
unless one side sends a (`Bar 1) and the other reads a (`Bar float)
<palomer>
right, but that shouldn't be a problem in automatically generated code
<palomer>
since integers will always be `Integer x, floats `Float x, etc...
<mrvn>
But I guess you are protecting against that with `Integer 1 and `Float 1.0 variants.
<mrvn>
palomer: yep
<palomer>
I'm just worried about the arities
Associat0r has joined #ocaml
<mrvn>
palomer: Why not make `Bar a list or array?
<mrvn>
`Variant [`Integer 1; `Float 1.0]
<palomer>
ah, you're right, that would fix the arity problem
<palomer>
but the question remains...is there an arity problem?
<palomer>
I always thought that matching a label was about hashing the label name
<palomer>
but this doesn't seem to be the case
<palomer>
since `Bar will not match with `Bar x
<mrvn>
palomer: `Bar and `Bar of ... have different structure.
julm has quit [Read error: 110 (Connection timed out)]
<mrvn>
`Bar of int ist { `Bar; 1}
julm has joined #ocaml
<mrvn>
`Bar of int and `Bar of int * int will both match your `Bar x
* palomer
checks
Associat0r has quit [Client Quit]
<mrvn>
You can only differentiate 0 and some arguments due to the structure.
<mrvn>
Not how many.
<palomer>
ahhhh
<julm>
damn IRC
<palomer>
that explains everything
<palomer>
so the only potential error is that `Integer and `Foo hash to the same value, for some Foo
<mrvn>
That is always a risk.
<palomer>
highly unlikely, yes?
<mrvn>
wihtout your Obj.Magic ocaml would warn you about it
<mrvn>
Not sure if it still does with
<palomer>
warn me about what?
<mrvn>
a hash collision between two `xxx variants.
<palomer>
hrmph
* palomer
goes and ponders this in the shower
<palomer>
bbl
<mrvn>
If you have a type [`X | `Y] and X and Y hash to the same value then ocaml warns you
<mrvn>
but consider it unlikely.
<palomer>
actually, nevermind, my encoding doesn't care about collisions
<palomer>
variants will be `Variant, integers will be `Integer, etc...
<palomer>
records `Record
mbishop has quit [hubbard.freenode.net irc.freenode.net]
gildor has quit [hubbard.freenode.net irc.freenode.net]
jonafan has quit [hubbard.freenode.net irc.freenode.net]
rwmjones has quit [hubbard.freenode.net irc.freenode.net]
<palomer>
Integer is a potential label name inside `Variant
jonafan has joined #ocaml
gildor has joined #ocaml
rwmjones has joined #ocaml
mbishop has joined #ocaml
alexyk has quit []
Associat0r has joined #ocaml
yziquel has joined #ocaml
<yziquel>
anyone interested in writing a decent ocaml plugin for swig?
<yziquel>
i mean, you know, decent with respect to static typing?
Camarade_Tux has quit ["Leaving"]
_zack has joined #ocaml
<julm>
hahaha: # abs min_int;;
<julm>
- : int = -4611686018427387904
dabd has quit [Client Quit]
<yziquel>
anyway, if someone is interested in making a decent swig plugin for ocaml, drop me a line. It would be good to have a clean and rather automatic way to bind c++ libraries to ocaml. see you.
yziquel has left #ocaml []
_zack has quit ["Leaving."]
<palomer>
abs min_int = min_int;;
<palomer>
- : bool = true
<palomer>
well...now we know that abs has two fixed points
<julm>
ouais
ertai has joined #ocaml
yziquel has joined #ocaml
ccasin__ has joined #ocaml
<palomer>
hrmph, is there an ocaml library with a SQL datatype?
<yziquel>
palomer: not that i know of, but PG'OCaml might interest you...
thelema_ has joined #ocaml
Spiwack has quit ["Leaving"]
<palomer>
it's the datatype aspect that interests me
<palomer>
I want to derive stuff from the datatype (using type-conv)
ChristopheT has joined #ocaml
ChristopheT has quit [Remote closed the connection]
ChristopheT has joined #ocaml
ChristopheT has left #ocaml []
<palomer>
an html datatype?
BiDOrD has joined #ocaml
yziquel has left #ocaml []
yziquel has joined #ocaml
smimou has joined #ocaml
yziquel has left #ocaml []
_andre has quit ["leaving"]
Snark has quit ["Ex-Chat"]
bzzbzz has quit ["leaving"]
Associat0r has quit []
<komar_>
Hello, I have a question about camlp4. Is there any way to translate keyword to string?
<komar_>
For example, I have a line in EXTEND Gram: expr: [ [ "word"; w = SELF -> <:expr< "$w$" >> ]];
<komar_>
If I type word wtf;;, it returns string = "$w$", but I want "wtf"
Associat0r has joined #ocaml
smimou has quit ["bli"]
<julm>
komar_: maybe $str:w$
<julm>
without the surrounding ""
<komar_>
hm, it returns type error.
<komar_>
Maybe I do something wrong? I'm not advanced user of camlp4.
oriba has joined #ocaml
yziquel has joined #ocaml
oriba has left #ocaml []
_zack has joined #ocaml
slash_ has joined #ocaml
<julm>
neither am I, I suppose that if you use STRING instead of SELF you will have to type {word "wtf"} instead of {word wtf}
<komar_>
It's a solution.
<komar_>
But I want {word wtf} :)
_zack has quit ["Leaving."]
palomer has quit ["Leaving"]
bombshelter13_ has quit []
<julm>
komar_: you could use expr: [ [ "word"; w = a_LIDENT -> <:expr< $str:w$ >>]];
thelema_ has quit ["ChatZilla 0.9.85 [Firefox 3.5/20090624025744]"]
yziquel has quit [Remote closed the connection]
jeff_s__ has joined #ocaml
<jeff_s__>
I've been wondering - in the Str module, if I want to include a ] or - in a character set, and I want the negation of that set, how do I do it? It seems like it'd be impossible since it says '^' for negation and ']' for including
<jeff_s__>
']' both have to be the first characters in the set.
<julm>
jeff_s__: [^]] does not work?
<jeff_s__>
bleh, I guess I should've tried that. thanks
<julm>
and if it's like in sed, - could be but at the end of the set