gildor changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | OCaml 3.12.1 http://bit.ly/nNVIVH
<mrvn> Args, Obj.field starts at 0. The block is size 1 so Obj.field t 1 reads beyond the block.
<mrvn> Drakken: The type id of a Constructor with arguments is encoded in the tag field of the block
<Drakken> what's a block?
<Drakken> is that just an array of bites that represent the value?
<Drakken> or words. not bytes.
<mrvn> Drakken: A block is a chunk of memory. It starts with one value that contains a tag, the length of the block and some internal bits for the GC followed by n values of contents.
<mrvn> Anything that isn't a simple type like int, char, unit etc is stored as block
bzzbzz has quit [Quit: leaving]
<Drakken> oh. I thought there was usually a pointer to the data. maybe I'm thinking of Lisp.
<mrvn> Drakken: the pointer always points to a block
<Drakken> but an array of floats isn't actually a C array of blocks, is it? It's an array of pointers?
<mrvn> # debug [|1.0; 2.0;|];;
<mrvn> { Block: tag = 254, size = 2,
<mrvn> [| 1.000000; 2.000000; |]}
<mrvn> Obj.double_array_tag is 254
<mrvn> This is my debug function: http://paste.debian.net/160717/
err404 has quit [Remote host closed the connection]
<mrvn> Drakken: Normaly it should be an array of values, each value being a pointer to a block with tag 'double_tag' and containing a double. But ocaml optimizes that into a single block containing only doubles.
<Drakken> right.
Cyanure has quit [Remote host closed the connection]
benozol has quit [Ping timeout: 252 seconds]
KDr2 has joined #ocaml
<xenocons> mrvn: cool
<xenocons> hrmm
<xenocons> is it easy to get the ocaml IL into the repl?
<mrvn> il?
<xenocons> like bytecode
<xenocons> well actually i dont know how the repl of ocaml really works, i guess assembly would be cool
<xenocons> lisp/scheme have disassemble/decompile in the repl
<mrvn> ocaml doesn't optimize so it should be quite easy to decompile.
<xenocons> imo that is an awesome feature
<xenocons> wonder if someone has already done it
<mrvn> I just use objdump -d
<xenocons> that isnt inside the repl though
<xenocons> and its linux only
<xenocons> and it doesn't encourage tinkering as much on a per function basis =P
<mrvn> the native compiler isn't in the toplevel eigther so no loss.
<xenocons> ah
<pippijn> what about a bytecode disassemblyß
<xenocons> itd be cool to have a verbosity flag
<xenocons> disassemble asm foo
<xenocons> disassemble il foo
<xenocons> i think i can do the IL easily in F# stuff
<xenocons> duno about ocaml or how accessible it is
<xenocons> (from the top level)
<mrvn> you can probably write one quite easily. The interpreter can already interpret the code. All you have to do is print the code instead of executing it.
<xenocons> mm makes sense
<xenocons> so is ocamls toplevel using a bytecode?
<mrvn> yes.
<xenocons> is there only one bytecode compiler ? heh
<xenocons> i should google :)
<pippijn> ok, now I have a disassembler
<xenocons> hehe
<xenocons> there is an ILGenerator :))
<pippijn> disassembly of: print_string "Hello world\n"
<xenocons> neat
<xenocons> what is your function to do this?
<pippijn> I use some modules from js_of_ocaml
<xenocons> cool
<pippijn> if you want to try it
<xenocons> now, to write your own bytecode -> Native compiler :)
<xenocons> cool ty
<pippijn> ocaml setup.ml -all
<pippijn> ./ocamldis
<pippijn> it's hardcoded to disassemble hello.byte
<pippijn> you can add Sys.argv.(1) or something if you like
<xenocons> this is cool
<xenocons> heh
<xenocons> :)
<xenocons> that was quick
<pippijn> bytecode -> C might be interesting
Tobu has quit [Ping timeout: 272 seconds]
<pippijn> I'd like to know how it performs in comparison to ocamlopt
<xenocons> oh my
<xenocons> this is easier than i thought for .NET
<xenocons> doesn't work in mono though, only .NET
<pippijn> interesting: ocamlc doesn't do any optimisation at all
<pippijn> let _ = 12345 + 1
<pippijn> becomes
<pippijn> mh = 12345
<pippijn> mi = 1
<pippijn> mj = mh + mi
<xenocons> cool
<xenocons> java is similar
<pippijn> javac does simple constant folding
<pippijn> "hello" + 3 becomes "hello3"
<xenocons> well then the jad decompiler i used was wrong :)
<pippijn> final String foo = "foo"; foo + "bar" becomes "foobar"
<xenocons> i saw x blah = blah ^ 90 + 7
<pippijn> of course
<pippijn> how do you want to optimise that?
<pippijn> unless blah is compile time constant
<xenocons> well, sorry i mean
<xenocons> blah ^ (90+7)
<xenocons> result was most definetly blah ^ 97
<xenocons> was doing lots of strange stuff with base64 too
<xenocons> ah i wasnt looking at the bytecode perse i was using JAD which essentially decompiles to jvm instructions, then goes back up to java
<pippijn> if jad can turn that into 90 + 7
<pippijn> then it's reading something else than bytecode
<pippijn> maybe debug info
<xenocons> so to give an unbiased assessment, i should have looked at the bytecode
<xenocons> ah ok
<xenocons> it was definetly bewildering
<pippijn> I find bytecode easy to read, these days
<xenocons> to this day im not entirely sure wtf was happening with that code
<pippijn> ever since I wrote a JVM
<xenocons> everysingle string was 'encrypted' lol
<xenocons> but the function doing it was called Base64.Concat :\
<xenocons> and it was basically like let concat x y = x ^ y or something odd
<xenocons> wondering if JAD got confused
<pippijn> jad can get confused if jumps are restructured
<xenocons> er in this case, ^ is xor
<xenocons> not join
<xenocons> so E(m,k)
<pippijn> xenocons: would you be interested in writing an ocaml bytecode -> C compiler?
<xenocons> well my feeling was that maybe some compiler for java was doing some kind of string encryption or compression
<xenocons> pippijn: hmm i would be interested in seeing it
<xenocons> i wouldnt be capable of maintaining concentration to write it myself
<pippijn> we could write it together
<xenocons> would i be any good at writing an ocaml project? hmm duno
<xenocons> im happy to try though
<xenocons> but be aware i could be more damage than good :)
<pippijn> we could start with js_of_ocaml
<pippijn> and replace the backend
<pippijn> shouldn't be more than a few days work
<xenocons> so js_of_ocaml already has the ability to get the bytecode and parse ect and translate to JS
<pippijn> yes
<xenocons> you want to just replace the to_js part with to_c
<pippijn> yes
<xenocons> that makes sense
dsheets has quit [Quit: Leaving.]
<xenocons> how would it work though? i mean
<xenocons> i guess i should look at js_of_ocaml
<xenocons> to get an idea
<pippijn> basically
<pippijn> replace the Generate module
<pippijn> that's it
<xenocons> heh im just in that file
<xenocons> its roughly 1481 loc
<pippijn> that one + all the js_ files is about 3KLOC
<xenocons> how easy is a -> C though? i mean js is actually quite functional (or can be)
<xenocons> a lot of stuff can be translated easily anyway
<xenocons> how would you do translate for example, a map
<xenocons> its easy in js right, but C you have to worry about realloc and stuff
<xenocons> memory management :\
<xenocons> maybe its easier to go ocaml -> native -> assembly -> C lol
<xenocons> (hexrays does it, very poorly though)
<xenocons> i mean stuff like printf is obviously easy enough to translate..
dsheets has joined #ocaml
<xenocons> printf easy, sprintf, i dont know
<pippijn> let's keep memory management out of the picture for now
<xenocons> ok
<pippijn> and printf is super hard
<pippijn> but not harder than map :)
<xenocons> hah
lamawithonel has joined #ocaml
<xenocons> fair enough
<xenocons> so where do we start
<xenocons> should probably get some sorta source control\project page i guess
Tobu has joined #ocaml
ftrvxmtrx has quit [Ping timeout: 240 seconds]
<pippijn> just to give you an idea
<pippijn> a byte code disassembly with List.map is 2037 lines
<pippijn> a printf is 5503
<xenocons> lol
<xenocons> holy smokes
<xenocons> mostly because its a library call right?
<pippijn> because it's a function implemented in ocaml
<xenocons> oh
ftrvxmtrx has joined #ocaml
<pippijn> ocamldis itself disassembles to 26849 lines
<xenocons> whoah
<pippijn> 18891 of those are actual instructions
<xenocons> hmm
<pippijn> 1230 insns for the map
<pippijn> 3524 for printf
<xenocons> so printf is nasty
<pippijn> not nastier than map
<pippijn> just larger
<xenocons> fair enough
<xenocons> i guess
<xenocons> printf has lots of functions
<xenocons> map can be replaced with function pointers maybe :)
<pippijn> ha
<pippijn> inlining is good
iago has quit [Quit: Leaving]
<pippijn> printf now has 1575 lines
<pippijn> map 81
<xenocons> nice
<xenocons> big reduction
<pippijn> ok, C will not be so easy
<pippijn> let's go with C++
<xenocons> hah
<pippijn> that has lambda functions and exceptions
<xenocons> #include <functional.h>
<pippijn> hmm
<pippijn> ocaml really isn't thread safe
<pippijn> it uses global variables for lambda captures
jimmyrcom has quit [Ping timeout: 252 seconds]
andreypopp has joined #ocaml
cdidd has joined #ocaml
d3z has joined #ocaml
<d3z> Does anyone have an example of how to use a "string option" using the config-file library?
Tobu has quit [Ping timeout: 272 seconds]
Tobu has joined #ocaml
andreypopp has quit [Quit: Quit]
Submarine has joined #ocaml
Submarine has quit [Changing host]
Submarine has joined #ocaml
Submarine has quit [Ping timeout: 246 seconds]
clog has joined #ocaml
albacker has joined #ocaml
zcero has quit [Read error: Connection reset by peer]
pango is now known as pangoafk
zcero has joined #ocaml
ftrvxmtrx has quit [Quit: Leaving]
zcero has quit [Read error: Connection reset by peer]
<adrien> hi
Submarine has joined #ocaml
Submarine has quit [Changing host]
Submarine has joined #ocaml
milosn has quit [Read error: No route to host]
milosn has joined #ocaml
albacker has quit [Ping timeout: 244 seconds]
zcero has joined #ocaml
ikaros has joined #ocaml
zcero has quit [Quit: Lost terminal]
<f[x]> thomasga, there is one in mldonkey
<f[x]> and I guess many more around the net
<flux> it's not that easy to detach code from mldonkey, though
<flux> which is sort of a shame, because I'm sure there'd be lots of code that could be reused in other contexts..
djcoin has joined #ocaml
Submarine has quit [Ping timeout: 276 seconds]
Snark has joined #ocaml
<mrvn> pippijn: lambda captures?
<thomasga> f[x]: I've finally took some pieces from xen-api-libs to make another one https://github.com/samoht/ocaml-wget :-)
Cyanure has joined #ocaml
<f[x]> thomasga, :)
<f[x]> flux, yeah
<djcoin> thomasga: the "Citrix' HTTP library" link in the README seems to be missing a target, don't know if that matters :)
Kakadu has joined #ocaml
<Kakadu> hi all!
<Kakadu> let's we have an executable and a library in _oasis file
<Kakadu> library is copilable using ocamlbuild
<Kakadu> compilable*
<Kakadu> Executable needs this library to compile
<Kakadu> when I call `ocaml setup.ml -build` the executable is going to compile before library and ofcourse build fails
<Kakadu> but when I add `BuildDepends: library` to the Executable block
<Kakadu> build fails while finding circular dependencies
<Kakadu> (files while building executable, building a library is still successsful)
<Kakadu> I'm really confused about this behaviour
ikaros has quit [Quit: Ex-Chat]
iZsh has quit [Ping timeout: 245 seconds]
<thomasga> djcoin: thx! this is fixed now
<djcoin> :) Seems great btw !
cago has joined #ocaml
<Drakken> How do I tell ocamlbuild to make sure my camlp4 lib is built before building the project that uses it?
<Drakken> I added the tag pp("camlp4 foo.cmo"), but ocamlbuild said it couldn't find the command "camlp4 foo.cmo".
<Drakken> Then I built foo.cmo manually, but ocamlbuild complained about "leftover compiled files".
iZsh has joined #ocaml
<f[x]> Drakken, dep
<Drakken> what?
<f[x]> dep ["ocaml"; "ocamldep"; "use_openin"] ["pa_openin.cmo"];
Znudzon has joined #ocaml
<Drakken> f[x] is your french better than your english?
<f[x]> no
<Drakken> Is dep a tag? or are you asking me to run ocamldep?
<Drakken> I don't understand what you wrote.
ftrvxmtrx has joined #ocaml
<f[x]> put that in mycaomlbuild.ml
<f[x]> it introduces the dependency
<Drakken> oh. okay, I'll have to read up on that.
<Drakken> thanks
<f[x]> all the files that have use_openin tag will need pa_openin.cmo built before
<f[x]> so you add the corresponding tag into _tags for all the files you want to preprocess
<f[x]> and ocamlbuild will build preprocessor before trying to prerpcoess those files
<f[x]> that's it
<Drakken> that's fine. I haven't used myocamlbuild.ml before.
<f[x]> in this case you hopefully will neeed only one that line
benozol has joined #ocaml
Submarine has joined #ocaml
Submarine has quit [Changing host]
Submarine has joined #ocaml
Znudzon has quit [Ping timeout: 252 seconds]
thizanne has quit [Ping timeout: 245 seconds]
thizanne has joined #ocaml
ocp has joined #ocaml
KDr2 has quit [Read error: Connection reset by peer]
<xenocons> pippijn: i was screwing around with MSIL, its actually really easy to get from the F# repl
<xenocons> http://codepad.org/yVxqji1W probably going to work on that
<pippijn> I like |>
<xenocons> yeah it lines stuff up well
<xenocons> nice
<xenocons> i see you use it heh
<xenocons> can also use ||>
<pippijn> what is that for?
<pippijn> ok
<xenocons> a,b basically
<xenocons> oh there is also |||> lol
<xenocons> let (>>) f g = fun x -> f (g (x));; maybe useful in ocaml if you dont have an operator
<djcoin> arf
<xenocons> im a bit of a pointfree addict of late
<pippijn> pointfree?
<xenocons> i believe its a haskell term http://www.haskell.org/haskellwiki/Pointfree
<xenocons> basically, not needing to declare function parameters
<pippijn> ok
<pippijn> yes, that's possible, too
<xenocons> im ocaml there is the 'function' alternative to match x with
<xenocons> that is sorta point free
<xenocons> i believe
<pippijn> I use that as much as possible
<xenocons> ive been using = function a lot like this http://codepad.org/qDDqGD6e
<pippijn> but it's slower if you nest them
<xenocons> feels more lightweight than match
<xenocons> ah
<pippijn> much slower actually
<xenocons> i try not to nest pattern matching deeper than once
<xenocons> *try*
<xenocons> ah nice
<xenocons> using match .. with
<pippijn> I used to have let message = function 16 -> begin function TK_IDENTIFIER _ -> "foo" end
<pippijn> but that actually generates a lot of functions in the native code
<pippijn> and those are not inlined
<xenocons> ah
<xenocons> it should compile to a switch right
<xenocons> i mean, i always assumed that
<pippijn> sure
<pippijn> actually it usually compiles to a if/else/else/else
<xenocons> ah ok
<Ptival> is there a common symbol for %revapply?
<xenocons> hmm im not sure what %revapply is
<Ptival> I used ( >>> ) in one of my developments, but if people are used to something else...
<Ptival> let ( >>> ) x f = f x
<xenocons> ah well, just F# uses >> and <<
<xenocons> for composition
<xenocons> <<< and >>> are binary shifts
<Ptival> I just did the opposite then
<xenocons> heh
<xenocons> pippijn: i like being able to use function like this
<xenocons> List.exists (function Vowel _ -> true | _ -> false)
<xenocons> where Vowel is a type
<pippijn> Vowel is a tycon
<xenocons> hah
<xenocons> ive been doing the NLP course work @ standford online
<xenocons> think ive got a stemming alg i can submit now
<pippijn> what about applying several functions to the same arguments?
<xenocons> hmm like f g x = g x; g x ?
<pippijn> let seq f g = fun x -> f x; g x
<xenocons> could be useful
<xenocons> getting into monad territory though right
<Ptival> isn't there a monad hidden in here? )
<xenocons> heh
<xenocons> i still haven't read ocaml monads yet
<pippijn> I didn't use monads, yet
Cyanure has quit [Ping timeout: 264 seconds]
<pippijn> I don't know what I can do with them
<xenocons> you probably used them without realising
Tobu has quit [Ping timeout: 260 seconds]
<xenocons> imo, it seems to be one of those things
<xenocons> behind all things
<xenocons> heh, from what little i know about them
<pippijn> interesting
<xenocons> i think ocaml vs F# are going in different directions here
<xenocons> probably because how ocaml lets you have higher order modules or whatever, but i doubt that would be possible in F# because of .net *starts rambling*
benozol has quit [Quit: Konversation terminated!]
rixed has joined #ocaml
benozol has joined #ocaml
<pippijn> xenocons: http://paste.xinu.at/sgu3b/ocaml <- #1
<pippijn> xenocons: http://paste.xinu.at/6pYL/ocaml <- #2
<xenocons> nice, i see you are using a record as a parameter, very SML hehe
<xenocons> what is this for?
<pippijn> a C parser
<xenocons> i see __asm__ and im interested
<xenocons> nice
<xenocons> pipe works well there
Submarine has quit [Quit: Leaving]
<pippijn> I decided against an operator for (fn, arg)
<pippijn> it would have been nicer to not need the ,
<xenocons> there are lots of types in this
<xenocons> ah yeh
<xenocons> hmm
<xenocons> do you need the , ?
<pippijn> but that's how fold works
<xenocons> cant you just curry it
<pippijn> no
<pippijn> let (|>) x (f, a) = f x a
<pippijn> x is between f and a
_andre has joined #ocaml
<xenocons> hmm ok
<xenocons> ah
<xenocons> heh
<xenocons> i see...
<xenocons> that is slightly annoying lol
<xenocons> there must be a way!
<pippijn> this is the way
<pippijn> there has to be an operator between the names
<pippijn> the only other way is to make the functions curryable
<pippijn> by inverting the arguments
<xenocons> when you send it to the argument yes, but no need in the function parameters i thoyguht?
<xenocons> ah
<xenocons> okay
<xenocons> i guess its clear enough though riht
<xenocons> right
<xenocons> er
<xenocons> like
<xenocons> hmm i see
<pippijn> | FunctionCall (_, callee, args) -> data |> (efn, callee) |> (fold_left efn, args)
<pippijn> it's consistent
<xenocons> yeah
<pippijn> fold_left needs this handling
<pippijn> (List.fold_left)
<xenocons> fold back = fold left i think, i haven't realy used it
<xenocons> val it : (('a -> 'b -> 'b) -> 'a list -> 'b -> 'b) = <fun:closure@98-2>
<xenocons> only normal fold for trivial things like summation
skchrko has joined #ocaml
<xenocons> fold would be a great thing to learn how to use constantly
<xenocons> hopefully it will come with practice
<pippijn> I use fold over the AST to collect symbols
<xenocons> nice
<xenocons> this is cool
<xenocons> so many pattern identifiers though
<xenocons> does ocaml have active patterns
<Ptival> xenocons: you know monads but not fold???
<xenocons> Ptival: heh i dont know monads
<xenocons> think i use them transparently without giving much though about it
<pippijn> I first fold over the AST to get all symbols and then I insert them into the imperative Hashtbl.t
<pippijn> I prefer to keep things functional as much as possible
<xenocons> no functional datastructures? hehe
<pippijn> and it's not much slower
<pippijn> xenocons: my symtab is not functional
<pippijn> my hindley-milner implementation is 100% functional
<xenocons> cool
<pippijn> http://paste.xinu.at/pVnWC/ <- this is the Hm_env
<pippijn> HM is therefore kind of a fold
<xenocons> whats your reason for writing C parsers? proving , smt, translation or just kicks?
<adrien> madness
<xenocons> so you implemented HM in terms of fold?
<xenocons> how long did it take to work out
<pippijn> no..
<pippijn> it's just kind of a fold
<xenocons> ok
<xenocons> this : in the type declaration is this to denote a struct?
<pippijn> yes
<xenocons> ok
<pippijn> you can try it out
<xenocons> kewl 1 sec
<pippijn> xenocons: http://paste.xinu.at/W1r/ <- these are from the testsuite
<xenocons> wow this is cool
<xenocons> hmm
<pippijn> the same thing also exists as gtk application :)
Tobu has joined #ocaml
<xenocons> have you done any stuff around proving properties of C programs
<xenocons> nice, syntax highlighting to boot
<pippijn> you may need to force-reload
<pippijn> xenocons: not yet, but I'm going to
<pippijn> using simplify or why
<xenocons> awesome!
<xenocons> ive always thought it would be fun to do basic stuff like
<pippijn> by the way, the JS frontend uses the same code as the GTK one
<pippijn> xenocons: I want DbC
<xenocons> checking if a function parameter length exceeds allocated buffer within the function ect
<xenocons> dbc?
<pippijn> /*! requires i > 10 */ int foo (int i);
<xenocons> its awesome how the results come back without actually having to submit anything
<xenocons> lol
<xenocons> i was like, huh?
<xenocons> now i click on view src and see what you did there
<xenocons> fucking. epic.
<xenocons> lol
<xenocons> fcc_js.js has 1144 lines
<xenocons> nicee
<xenocons> i cant believe how quick it is
<pippijn> I tried your msil thing
<pippijn> let _ = printMSIL (fun () -> 3)
<pippijn> I get a huge listing
<pippijn> 1260 lines
<xenocons> hah
<xenocons> ive noticed it does seem to print a lot more than what i would expect for a single function
<xenocons> planning on trying to work out what exactly its getting, its possible im iterating the entire assembly
<pippijn> I think so
<xenocons> easy enough to refine down
<xenocons> haha void function (char *str) {"<script>alert(1);</script>";} ;)
<xenocons> making ocaml compiled js render an xss
<pippijn> it doesn't work here
<xenocons> browser dependant
<xenocons> many will block that type of basic xss
<xenocons> although, chrome had an interesting one
<xenocons> you could get <script>alert(1);</script
<xenocons> deliberately leaving off the >
<xenocons> it gets parsed by their xss detection stuff on the clientside, and then goes oh thats not a script
<xenocons> but the html gets repaired before rendering to the user
<xenocons> pippijn: hehe
<xenocons> void function (char *str) { "<img src='http://i.imgur.com/CPBUl.jpg'>";
<xenocons> }
<xenocons> meow
<pippijn> nice
Submarine has joined #ocaml
<xenocons> tempted to try see how far it will recurse the {}'s
<xenocons> hehe
<xenocons> is there a depth limit
<pippijn> there is
<pippijn> not in the parser, but in the printer, which is not tail-recursive
<xenocons> ok
<pippijn> so there is a depth limit imposed by the JS VM
<pippijn> maybe around 400
<xenocons> ah
<pippijn> there is also a limit in the hindley-milner thing
<pippijn> a type variable limit
<xenocons> ok thats good
<xenocons> when is ocaml 4.0 out?
<adrien> in the future
<xenocons> damn, thought so
<pippijn> I could lift the limit
Tobu has quit [Remote host closed the connection]
Tobu has joined #ocaml
<xenocons> if its limited i wouldnt owrry
<xenocons> s/ow/wo
<adrien> xenocons: probably around June
<xenocons> cool
<xenocons> wonder if the emacs option wll be selected by default on the windows distrib ;)
<xenocons> it has tricked me twice now
<pippijn> lifted
<xenocons> is Option stuff like get, map meant to be in the toplevel already or do you need to #load something
<xenocons> wanting to verify something with None and printf in ocaml
<xenocons> im of the belief it is a bug in F#
<pippijn> xenocons: http://paste.xinu.at/fGS3F/
<pippijn> no more arbitrary limits
<xenocons> haha nice
<xenocons> thats very long
emmanuelux has joined #ocaml
<xenocons> heh
<xenocons> it doesnt even work in F# :)
<xenocons> too long
<mrvn> luckily this is #ocaml
<xenocons> hehe
<xenocons> so, talking ocaml, how does one use get on type option
emmanuelux has quit [Remote host closed the connection]
<xenocons> http://ocaml-lib.sourceforge.net/doc/Option.html i must be reading this incorrectly
<mrvn> # let get = function Some x -> x | None -> raise (Invalid_argument "get None");;
<mrvn> val get : 'a option -> 'a = <fun>
<mrvn> # get (Some 1);;
<mrvn> - : int = 1
<xenocons> hmm...
<mrvn> Not sure what ocaml-lib is but you would need to add that to your toplevel before use.
<xenocons> ah its not builtin then, isee
<mrvn> The option type is but that Option module is something extra
emmanuelux has joined #ocaml
<xenocons> i dont think i will be able to test this in ocaml then
<xenocons> think the bug is in how F# treats None internally
* rwmjones doesn't suppose we have an OCaml native code backend for s/390{,x}?
<xenocons> figure ocaml treats it much differently
<mrvn> no
<mrvn> # None;;
<mrvn> - : 'a option = None
<mrvn> If you use that in the module then tou need to type it.
<xenocons> still confused as to why the printf doesnt type fail, i guess ill messagebord it
<mrvn> why should it? None is an 'a option and .Value is 'a option -> 'a.
<xenocons> then why does (None).Value type fail?
<mrvn> You need phantom types or GADT to make the type system see that (None).Value is invalid.
<xenocons> ah
<xenocons> it only fails when it is involved with printf afaik
<mrvn> It isn't a type failure here
<xenocons> hmm ok well
<mrvn> xenocons: .Value is defined something like let value = function Some x -> x | None -> raise System.NullReferenceException
<xenocons> to me, imo, (None).Value;; and printf "%x" (None).Value should have the exact same error
<xenocons> mrvn: well that makes sense
<mrvn> Maybe the f# compiler knows that .Value has no side effect and optimizes the first away but not the later
<xenocons> that would be a reasonable assumption
<xenocons> harrop found a stack overflow in how JIT iz optimizing a tail call heh
<mrvn> Would be wrong because raising an exception certainly has side effects but f# might ignore that
<xenocons> right, exceptions are costly
<xenocons> didnt crash ocaml toplevel :)
<mrvn> being costly isn't a side effect. Aborting the function is.
<xenocons> aborting a function is costly i guess?
<mrvn> being costly isn't a side effect
<xenocons> ok
skchrko has quit [Ping timeout: 240 seconds]
skchrko has joined #ocaml
skchrko has quit [Remote host closed the connection]
jimmyrcom has joined #ocaml
cyphase has quit [Ping timeout: 245 seconds]
wicko has joined #ocaml
Znudzon has joined #ocaml
<wicko> Hi. I'm using lablgtk to make a little drawing program. I want to draw an image, saved in myfile.png, onto my backing pixmap. What's the best way to do that? Thanks.
<zorun> wicko: isn't there a documentation? I guess adrien could help, though
rby has quit [Ping timeout: 252 seconds]
<wicko> What I'm trying at the moment is converting my file to xpm, then generating a pixmap from that using Pixmap.create_from_xpm, and then putting that pixmap onto my drawing area. But the create_from_xpm call throws an error complaining that the assertion `drawable != NULL || colormap != NULL' failed.
rby has joined #ocaml
Cyanure has joined #ocaml
oriba has joined #ocaml
<_andre> does anyone from the debian ocaml team hang around here?
<mrvn> _andre: better go to #debian-ocaml@irc.debian.org
rby has quit [Ping timeout: 252 seconds]
<_andre> mrvn: thanks
rby has joined #ocaml
Tobu has quit [Ping timeout: 272 seconds]
wicko has left #ocaml []
Tobu has joined #ocaml
iago has joined #ocaml
cago has quit [Quit: Leaving.]
rby has quit [Read error: Connection reset by peer]
milosn has quit [Read error: Connection reset by peer]
cfa has left #ocaml []
ocp has quit [Ping timeout: 252 seconds]
Tobu has quit [Ping timeout: 260 seconds]
milosn has joined #ocaml
rossberg_ has quit [Quit: Leaving]
rby has joined #ocaml
avsm has joined #ocaml
Znudzon has quit [Ping timeout: 245 seconds]
Tobu has joined #ocaml
oriba has quit [Quit: oriba]
Submarine has quit [Ping timeout: 244 seconds]
iago has quit [Ping timeout: 264 seconds]
avsm has quit [Quit: Leaving.]
thizanne has quit [Ping timeout: 248 seconds]
thizanne has joined #ocaml
<pippijn> oh!
<pippijn> ugh :(
<pippijn> stupid mutable strings
<adrien> otoh, if you were in C, you'd be doing [ return "a"; ] in the code of the function you're calling
<adrien> no free lunch :-)
Cyanure has quit [Ping timeout: 260 seconds]
seanmcl has joined #ocaml
Tobu has quit [Ping timeout: 272 seconds]
ftrvxmtrx has quit [Quit: Leaving]
skchrko has joined #ocaml
<_habnabit> adrien, unless you write it in python
<adrien> but it's not free for the performance eitehr
<_habnabit> python has some pretty dang good performance
<_habnabit> especially when you translate it to C
skchrko has quit [Quit: ChatZilla 0.9.88.1 [Firefox 11.0/20120314111819]]
avsm has joined #ocaml
<Drakken> The ocamlbuild pp tag takes a command as argument. Is there a way to specify a custom tag like that in a myocambuild.ml dep command?
Tobu has joined #ocaml
<Drakken> Repeating the problem I posted earlier:
<Drakken> I added the tag pp("camlp4 foo.cmo"), but ocamlbuild said it couldn't find the command "camlp4 foo.cmo"
<Drakken> Then I built foo.cmo manually, but ocamlbuild complained about "leftover compiled files".
<Drakken> But I'm not sure how to specify a custom tag in the dep statement.
benozol has quit [Quit: Konversation terminated!]
Submarine has joined #ocaml
Submarine has quit [Changing host]
Submarine has joined #ocaml
iago has joined #ocaml
lorill has joined #ocaml
ulfdoz has joined #ocaml
iago has quit [Quit: Leaving]
sepp2k has joined #ocaml
djcoin has quit [Quit: WeeChat 0.3.2]
avsm has quit [Quit: Leaving.]
Tobu has quit [Ping timeout: 272 seconds]
wicko has joined #ocaml
Tobu has joined #ocaml
Xizor has joined #ocaml
<wicko> Hello. What's the best way to catch key_press events (specifically the 'enter' key) on a GEdit.entry object? There doesn't seem to be a #connect#key_press method for this kind of object.
Xizor has quit [Client Quit]
lorill has quit [Quit: Ex-Chat]
wicko has quit [Ping timeout: 245 seconds]
ftrvxmtrx has joined #ocaml
twittard has quit [Quit: twittard]
seanmcl has quit [Quit: seanmcl]
alpounet has quit [Quit: Bye.]
<adrien> damn
<adrien> for wicko, there is a #connect#validated or something like that method
alpounet has joined #ocaml
pangoafk is now known as pango
albacker has joined #ocaml
albacker has quit [Changing host]
albacker has joined #ocaml
twittard has joined #ocaml
<pippijn> what's people's opinion on literate programming?
cyphase has joined #ocaml
<jonafan> i have always viewed comments as line noise
blue_prawn has joined #ocaml
<blue_prawn> gildor: Hi, is it possible and how to not install the ocamldoc generated doc with setup.ml -install ?
<blue_prawn> or maybe someone else can answer too ?
Snark has quit [Quit: Quitte]
twittard has quit [Quit: twittard]
twittard has joined #ocaml
iago has joined #ocaml
Drakken has quit [Ping timeout: 252 seconds]
_andre has quit [Quit: leaving]
Cyanure has joined #ocaml
Kakadu has quit [Quit: Konversation terminated!]
Drakken has joined #ocaml
<pippijn> blue_prawn: Install: false
<blue_prawn> pippijn: ?
<blue_prawn> pippijn: where ? in which file ?
<blue_prawn> pippijn: sorry I don't understand
<pippijn> _oasis
<blue_prawn> have you understood that I what to install the lib, but that is only the ocamldoc generated doc that I don't want to install
<blue_prawn> ?
<pippijn> yes
<blue_prawn> I would expect a configure command line option
<blue_prawn> here is the _oasis file:
<blue_prawn> I don't see any "Document cparser" there
<pippijn> Document API
<blue_prawn> I would really prefer a command line option because it's for packaging purpose
<blue_prawn> isn't it possible ?
Tobu has quit [Ping timeout: 272 seconds]
<blue_prawn> patching the _oasis file doesn't seem a very nice solution for packaging
ulfdoz_ has joined #ocaml
twittard has quit [Quit: twittard]
ulfdoz has quit [Read error: Operation timed out]
ulfdoz_ is now known as ulfdoz
Tobu has joined #ocaml
cdidd has quit [Remote host closed the connection]
twittard has joined #ocaml
hcarty has quit [Ping timeout: 252 seconds]
MilLions has quit [Read error: Connection reset by peer]
MilLions has joined #ocaml
<jonafan> so, what's the best build environment?
<blue_prawn> joewilliams: I'm happy with make
<blue_prawn> jonafan: I'm happy with make
<_habnabit> jonafan, ocamlbuild is much, much nicer than using makefiles
<_habnabit> (well, you could have a makefile that calls ocamlbuild, but..)
Tobu has quit [Ping timeout: 272 seconds]
<jonafan> having never done anything practical in ocaml, i've never had a complicated thing to build
<_habnabit> ocamlbuild is nicer in all cases
<_habnabit> complexity doesn't really matter
<jonafan> i'm gunna try using ocsigen and it of course comes with sprawling makefiles
<blue_prawn> hand-written makefiles are nice, the problem is with generated makefiles
<_habnabit> blue_prawn, how many source files do your handwritten makefiles use
<blue_prawn> hte more I have done, I have not counted, but maybe arround 30 or 50
<jonafan> i found it pretty tedious to supply cmos in the correct order for the most complicated thing i ever built
<blue_prawn> there are tools that takes a list of .cmo and put it in the right order
<_habnabit> jonafan, ocamlbuild makes that a nonissue
<_habnabit> seriously. use ocamlbuild
<blue_prawn> seriously, compare and make your own choice
<_habnabit> but don't actually do that, because you'll waste a bunch of time writing makefiles
<blue_prawn> you don't waste your time, because you can use make with different languages
<blue_prawn> so you don't learn one build tool for each language
<_habnabit> how does that help you with an ocaml project
sepp2k has quit [Quit: Leaving.]
<jonafan> i already know how to use make, but ocaml seems more complicated to build than c and c++
<blue_prawn> I don't think so
<jonafan> i think ocaml is the only one that cares what order the object files are in
lclark has quit [Remote host closed the connection]
<_habnabit> jonafan, ocamlbuild! for the nth time, it takes care of this for you
<_habnabit> it is so easy
<blue_prawn> there are a lot of tricky things in C that don't exist in OCaml
<jonafan> in the c language maybe.
Tobu has joined #ocaml
lorill has joined #ocaml
<adrien> also, if you use make for ocaml, you also probably want to disable implicit rules as they are meant for C
Submarine has quit [Ping timeout: 245 seconds]
<blue_prawn> if these implicit rules are associated with .c file extenstion, it doesn't matter
<adrien> the one that has most often bitten me is: .o -> executable
<adrien> "make main" will simply run ld over "main.o" if it exists if it can :-)
<lorill> Hi. I wrote a mini game : https://bitbucket.org/vfiack/ocaml-minigames/src - I'd like some comments on the code organization and style if possible
<lorill> especially on my loading of images & sounds, I don't really like what I've done
<mrvn> grrr, I need type ('a * 'b) t = 'a 'b
<adrien> lorill: obviously, first thing: building it; what is the source of your ocaml distribution?
<lorill> not sure if I understood the question. I'm using ocaml on debian
<lorill> but this should work everywhere, provided sdl is installed
<adrien> iirc that won't work on my godi installation ;-)
<lorill> but yeah, between godi, oasis, omakefiles & ocamlbuild, i'm a little lost
<mrvn> Error: Unbound module Sdlmixer, and I don't have an SDL for ocaml 4.0 :(
<_habnabit> mrvn, what would that type mean
<lorill> so I use ocamlbuild since it also works well with ocaide
<lorill> but even if it compiled, that's a nice game for my 4 year old, but probably too easy for any adult :)
Cyanure has quit [Remote host closed the connection]
<mrvn> _habnabit: I need two lists: ('a key, 'a data) list and ('a key, 'a ptr) list where 'a is existential ia GADTs.
<mrvn> And I don't want to duplicate the code or use functors or something for the lists
<blue_prawn> lorill: my first comment on the code: your lines length is too long
<adrien> lorill: that is more portable provided ocamlfind support is available: ocamlbuild -I maze -use-ocamlfind -pkgs bigarray,sdl,sdl.sdlttf,sdl.sdlmixer sdlmaze.native
<mrvn> _habnabit: or in other words I want a (key, data) list that contains pairs of 'a key * 'a data
<adrien> (it's missing sdl loader right now)
<adrien> (and I'll kill people who avoid ocamlfind myself if needed =) )
<blue_prawn> lorill: most often it is recommanded 80 char max, 127 is far too long 'cause my term is only until 125
<adrien> the META I have through godi for sdl seems to be missing sdl loader =/
<lorill> yeah, I'm a bit lax on this, with widescreens, but this is noted. 80 seems hard to follow, though
<blue_prawn> lorill: if 80 is too short for you maybe you could limit to 90 or 100 max
<blue_prawn> lorill: if you are on linux you can check this with the command wc -L *.ml
<lorill> is ocamlfind part of the standard distribution ?
<lorill> blue_prawn: actually, my editor shows a bar at 80, so I can do this quickly
<lorill> i have no excuse
<lorill> ok, line length is fixed. I can't find ocamlfind on my system though
<blue_prawn> lorill: shouldn't the None case in the blit function raise an exception or print a warning ?
<blue_prawn> for what I understand this case should not happen
<lorill> yes, that's a part why I'm unhappy
<lorill> I don't know wether to keep this, instantiate a simple object, use a hashmap, or whatever
<lorill> with a hashmap i'll have to use strings, so a typo & runtime error becomes possible
<blue_prawn> I guess you're not happy with refs for your data, but I don't think it's really a problem
<lorill> more with the option actually
<adrien> lorill: ocamlfind is not part of the standard distribution; however, it's close to impossible to do actual ocaml development without it
<lorill> but I can't load them before calling sdl init
<lorill> adrien: i found the package
<lorill> but no sdlloader, as you found out before
<blue_prawn> lorill: yes and it is for the same reason that the std Arg module uses refs, it's not a real problem, problem is if a ref is a global variable really used and modified
<adrien> yeah, it's easy to hand-edit however
<lorill> does anyone still uses OCamlMakefile, or is this old legacy ?
<adrien> just copy paste any "subpackage" in the file named "META" which is for sdl
<adrien> and I'm adding "push fix for ocaml-sdl's META" to my TODO
<lorill> where are this meta files ?
<lorill> yeah, mine aren't global, but still nullable
<lorill> and i'd like if they weren't
<lorill> (ok, found the meta)
<adrien> ah, hmm
<adrien> I don't know if apt/dpkg is going to like that you change the file however
<lorill> can I make a local copy in the project or something ?
<adrien> I don't think so
<adrien> but currently, if I were you, I'd add the line I gave to build.sh but as a comment
<lorill> that's what i did
<adrien> and quickly explain why/when it can be useful
<lorill> but i don't use this script actually, ocaide does the build for me
<adrien> (I'm going to push that bug report right now)
<adrien> and as for OCamlMakefile, it's still actively maintained
<adrien> and it's not working bad
<blue_prawn> lorill: swap array i (Random.int (i+1)) shouldn't it be swap array i (Random.int i) ?
<blue_prawn> lorill: because Random.int n gives something from 0 inclusive and n exclusive
<blue_prawn> lorill: (in the shuffle function in generator.ml)
<lorill> the shuffle function was a copypasta actually
<lorill> i'm rereading it right now
<lorill> my guess would be that the original want to allow the item to stay in place
<lorill> but yeah, that's some ugly code to shuffle 4 directions
seanmcl has joined #ocaml
hcarty has joined #ocaml
<blue_prawn> indeed in this shuffle : http://rosettacode.org/wiki/Knuth_shuffle#OCaml it also does Random.int (n+1) probaly to allow stay in place as you said
<lorill> that's where it comes from :)
<lorill> i've replaced it with this
<lorill> let shuffle lst = List.sort (fun a b -> (Random.int 3) - 1) lst
<lorill> that's clearer and good enough for my use
ftrvxmtrx_ has joined #ocaml
<jonafan> why use the O(n) you have when you can use O(n log n) that doesn't work as well
ftrvxmtrx has quit [Ping timeout: 248 seconds]
<blue_prawn> when you have copy-past from there you have made a change, the original does a for downto, while the Array.iter does from 0 until the last one, so it is not equivalent
<lorill> yeah, i remembered the hostname, but that wasn't that actually :(
<lorill> (which incidentally also gives the second solution, but with a warning i don't understand)
<lorill> concerning my separation in modules, is this ok, too much modules, too few ?
<blue_prawn> it seems nice, but I've not read it enough to really understand everything
<lorill> ah, and is there's a naming convention for the "main" module ?
<blue_prawn> lorill: I would say the main module should have the same name than the generated prog
<blue_prawn> or just main.ml, but I don't think we can say it's a convention
<lorill> ok, thanks
ftrvxmtrx_ has quit [Ping timeout: 240 seconds]
jonafan_ has joined #ocaml
lorill has quit [Quit: Ex-Chat]
jonafan_ has quit [Client Quit]
jonafan has quit [Quit: leaving]
ftrvxmtrx has joined #ocaml
blue_prawn has quit [Quit: Quitte]
albacker has quit [Ping timeout: 260 seconds]
jonafan has joined #ocaml
albacker has joined #ocaml
albacker has quit [Changing host]
albacker has joined #ocaml
jonafan has quit [Client Quit]
jonafan has joined #ocaml
Rana has joined #ocaml
Rana has left #ocaml []
Tobu has quit [Ping timeout: 272 seconds]
<jonafan> okay, ocamlbuild is the way to go
<jonafan> consider me wooed
<_habnabit> hooray
albacker_ has joined #ocaml
albacker has quit [Read error: No route to host]
gmcabrita has quit []
albacker_ is now known as albacker
gmcabrita has joined #ocaml
Tobu has joined #ocaml
avsm has joined #ocaml
avsm has quit [Ping timeout: 244 seconds]
Znudzon has joined #ocaml
jmcarthur has quit [Read error: Connection reset by peer]
jmcarthur has joined #ocaml
mehdid_ has joined #ocaml
rjohnson_ has joined #ocaml
testcocoon has quit [Quit: Coyote finally caught me]
kaustuv has joined #ocaml
Tobu has quit [Ping timeout: 260 seconds]
<kaustuv> Has anyone successfully used ocamlbuild+ocamlfind+typerex?
<kaustuv> Specifically, (how) can I tell ocamlbuild -use-ocamlfind to use the ocp-* variants of the commands?
testcocoon has joined #ocaml
seanmcl has quit [*.net *.split]
rjohnson has quit [*.net *.split]
diml has quit [*.net *.split]
mal`` has quit [*.net *.split]
mehdid has quit [*.net *.split]
Znudzon has quit [Ping timeout: 244 seconds]