kaustuv 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
alexyk has joined #ocaml
oriba has quit ["Verlassend"]
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.
<sugalo> http://caml.inria.fr/download.en.html there are no choices on this page for a 64-bit build
<sugalo> thelema: heh i'd better not try
<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
<mfp> ah, then no need to build a 64-bit OCaml, just use Bigarray as thelema said http://caml.inria.fr/pub/docs/manual-ocaml/manual043.html
bombshelter13_ has joined #ocaml
<sugalo> ok; i hope it's not complicated :)
<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.
bzzbzz has joined #ocaml
<mfp> uses 'a array list instead of 'a array array, which seems a bit silly
<thelema> if you need only a little more than 4 million, I guess it'd work...
<mfp> IIRC somebody posted a 'a array array implementation to the ML
<mfp> hmm maybe Batteries material?
<thelema> yes, that's exactly what I was thinking. We've decided on a "additional data structures" section for things people just might want
<sugalo> Bigarray doesn't have a function 'make' or 'create' ?
<thelema> but that isn't really mainstream
<thelema> or isn't fully complete integrated into batteries
<mfp> sugalo: you have to pick the dimensionality, in this case Array1
<sugalo> oh sorry i didn't see the pages on the sub modules
<thelema> yes, it's a bit complicated to get started, but it's mighty powerful
<mfp> so you'll do something like open Bigarray let a = Array1.create int32 c_layout 100_000_000
<mfp> then you can index the bigarray with a.{n} and assign with a.{n} <- whatever
<sugalo> thanks that's helpful
<mfp> sugalo: you probably want to use "int" (= 31-bit ints for you) as the element type
<sugalo> thanks that works
<mfp> (int32 values would be boxed when you extract them from the bigarray, and you'd have to use the functions defined in Int32 to operate with them)
<sugalo> ok i see
<sugalo> writing 100_000_000 is the same than writing [|100000000|] ?
<mfp> 100_000_000 = 100000000
<mfp> it's the size
<sugalo> oh yes sorry, the create of Genarray wants an int array but of course Array1 just wants an integer
<sugalo> hm actually i didn't need 'int' but 'bool' so i guess i'll just use 'char' ?
<mfp> sugalo: if you only want a bit vector, there are a few around
<sugalo> great thanks
<mfp> uses a int array internally, so the max size will be limted to some ~120M elements on 32-bit OCaml
<mfp> *limited
<sugalo> ok
<mfp> if that's not enough, bigarrays of chars, as you said
<sugalo> thanks :)
<sugalo> what about get and set for the bit vector ?
<sugalo> is there a way to define a thing such as bitvector.{i} <- b ?
<mfp> if you use Bitv, Bitv.set bitvector i b
<mfp> there's a trick to reuse the x.() syntax for other modules that provide set/get
<sugalo> oh ?
<mfp> if you do module Array = Whatever, x.(n) expands to Whatever.get x n
<mfp> and x.(n) <- y to Whatever.set x n y
<sugalo> and then i can't use Array's anymore can I ?
<mfp> you could alias it with module A = Array
<sugalo> ok thanks
<mfp> but you cannot use .() for both at once
<mfp> unless you use delimited overloading
<sugalo> delimited overloading ?
<sugalo> thanks
<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
Associat0r has joined #ocaml
<palomer> sure you can, check out this paste: http://pastebin.com/m1dadbf9f
<palomer> it works
<palomer> but is it safe?
<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$ >>]];
<komar_> julm, thanks a lot! Absolutely.
<julm> if a_LIDENT is to restrictive for your wtf, then you should probably pass through the Camlp4.Printers machinery to get a string, as there for expr: http://caml.inria.fr/pub/ml-archives/caml-list/2007/10/addde06489f260c825abbc9746e2791c.en.html
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
<julm> -but+put
jeff_s__ has quit []
julm has quit [Connection timed out]
julm has joined #ocaml
slash_ has quit [Client Quit]
youscef has quit ["KVIrc 3.4.0 Virgo http://www.kvirc.net/"]
jeanbon has quit [Read error: 110 (Connection timed out)]
ChristopheT has joined #ocaml
ChristopheT has left #ocaml []
hkBst has quit [Read error: 104 (Connection reset by peer)]
maskd has quit [Read error: 60 (Operation timed out)]
ulfdoz has quit [Read error: 110 (Connection timed out)]
winsmith has joined #ocaml