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
sivoais has quit [Quit: Lost terminal]
diego_diego has joined #ocaml
<Lor> Is there some variant of printf that takes a format string and then simply consumes as many arguments as the format string requires, without actually doing anything with them?
sivoais has joined #ocaml
<thelema> Lor: yes, ifprintf
<thelema> If you're working on logging, you may wish to have a look at the BatLog interface in 2.0 beta
Tobu has quit [Ping timeout: 272 seconds]
Tobu has joined #ocaml
emmanuelux has quit [Remote host closed the connection]
Tobu has quit [Ping timeout: 272 seconds]
Tobu has joined #ocaml
diego_diego has quit [Quit: diego_diego]
diego_diego has joined #ocaml
diego_diego has quit [Quit: diego_diego]
diego_diego has joined #ocaml
ezyang has joined #ocaml
<ezyang> I want to create a new 'fprintf' style function that actually XML escapes its output before sending it off to standard output. How can I do this?
mietek has quit [Ping timeout: 276 seconds]
mietek has joined #ocaml
ftrvxmtrx has quit [Quit: Leaving]
<_habnabit> ezyang, what part is giving you trouble? also, why don't you just use xmlm?
<ezyang> The polymorphic return value. I don't understand how to schedule something to be run after the fprintf is done.
<ezyang> I'm modifying an existing codebase and if I rewrite 20% of its code it'll be a lot harder to get the devs to accept my patch :-)
<_habnabit> a codebase that just dumps out xml without using any library? ugh.
<_habnabit> I don't see why they wouldn't accept a patch to fix their broken code using xmlm
<ezyang> I want them to start dumping XML.
<ezyang> So they don't currently.
<ezyang> I can almost manage it. Most of their printing code is centralized in a pretty-printing module.
<ezyang> and the XML format we're going for has the invariant that if you strip_tags you get the non-XML'd version.
Cyanure has joined #ocaml
diego_diego has quit [Quit: diego_diego]
diego_diego has joined #ocaml
Cyanure has quit [Remote host closed the connection]
<diml> ezyang: let fprintf_xml fmt = Printf.ksprintf (fun str -> output_string stdout (escape_xml str)) fmt
bfgun is now known as bfig
<ezyang> ksprintf! Very handy
tufisi has joined #ocaml
mietek has quit [Ping timeout: 260 seconds]
abdallah has joined #ocaml
Skolem has joined #ocaml
cago has joined #ocaml
<Skolem> I would expect "foo (a:int) : int = a+1;;" to declare foo's type as int->int, but instead I get a syntax error. How can I fix that? I know the Ocaml compiler infers the type correctly, but I sometimes want to manually specify it when writing test programs.
<_habnabit> Skolem, let foo: int -> int = fun a -> a + 1
<_habnabit> or just let foo (a: int) = a + 1
<Ptival> yes you seem to be missing a let
<Skolem> Ptival: Oops, I missed the "let" when copying and pasting. My whole statement was "let foo a:int : int = a+1"
<Ptival> "let foo (a: int): int = a + 1" should be correct
<Skolem> _habnabit: The first does what I want, thanks. The second doesn't seem to manually specify the return type, unless I'm missing something.
<_habnabit> Skolem, it would be inferred from the + operator
<_habnabit> Skolem, better yet, you could use a .mli file
<Skolem> Pvital: So it is, thanks!
diego_diego has quit [Quit: diego_diego]
<Skolem> I'm getting another type error that I don't understand. See http://pastebin.com/MnJEkJNE I've explicitly defined the return type of _split to be ('a list * 'b list), but when I call it recursively it's saying that the expression in the recursive call has type 'a list. How is that possible?
silver has joined #ocaml
<_habnabit> Skolem, because of the :: operator
<_habnabit> you need parens, i.e. (a :: acc1)
<_habnabit> it's doing (_split xs a) :: (acc1 b) :: (acc2)
<Skolem> Ahhh… that fixed it. Thanks so much!
<Ptival> because function application has higher precedence
<_habnabit> writing a::acc1 without whitespace doesn't make the :: bind tighter
<Ptival> :)
<Ptival> whitespace-width-driven precedence
<_habnabit> sometimes I wish it existed
<_habnabit> and then I realize "oh jesus that would be terrible"
<Ptival> yeah :D
Tobu has quit [Ping timeout: 260 seconds]
<Ptival> especially when newlines are involved
Tobu has joined #ocaml
sgnb has quit [Remote host closed the connection]
sgnb has joined #ocaml
Submarine has joined #ocaml
Submarine has quit [Changing host]
Submarine has joined #ocaml
diego_diego has joined #ocaml
diego_diego has quit [Client Quit]
djcoin has joined #ocaml
albacker has joined #ocaml
albacker has quit [Changing host]
albacker has joined #ocaml
eikke has joined #ocaml
Tobu has quit [Ping timeout: 260 seconds]
<Ptival> so, there is no point in reporting a syntax coloring bug to typerex right?
thomasga has joined #ocaml
snearch has joined #ocaml
abdallah has quit [Quit: Ex-Chat]
fschwidom has joined #ocaml
Tobu has joined #ocaml
bfig has left #ocaml []
snearch has quit [Quit: Verlassend]
avsm has joined #ocaml
ggherdov has quit [Remote host closed the connection]
mika1 has joined #ocaml
Tobu has quit [Ping timeout: 272 seconds]
Tobu has joined #ocaml
albacker has quit [Ping timeout: 245 seconds]
Submarine has quit [Quit: Leaving]
<mfp> where's the Fisher-Yates shuffle to be found in batteries? can't find it in BatArray
<mfp> got it, Random.shuffle, going through Enum.t
Tobu has quit [Ping timeout: 272 seconds]
<Lor> thelema, that's great, but I need a continuation-passing version, and there's no kifprintf.
iago has joined #ocaml
avsm has quit [Quit: Leaving.]
<adrien> I really don't mind having to recompile all the ocaml libraries and programs whenever the compiler or the libraries change
<adrien> that's way better than "oh, program crashes; makes no sense"
<adrien> (just happend to me)
munga has joined #ocaml
ulfdoz_ has joined #ocaml
ulfdoz has quit [Ping timeout: 248 seconds]
ulfdoz_ is now known as ulfdoz
Tobu has joined #ocaml
Tobu has quit [Ping timeout: 272 seconds]
Zedrikov has joined #ocaml
Tobu has joined #ocaml
mrvn has joined #ocaml
<mrvn> moin
fschwidom has quit [Remote host closed the connection]
avsm has joined #ocaml
munga has quit [Ping timeout: 245 seconds]
albacker has joined #ocaml
albacker has quit [Changing host]
albacker has joined #ocaml
pango is now known as pangoafk
Zedrikov has quit [Quit: Bye all, see you next time!]
avsm has quit [Quit: Leaving.]
ulfdoz has quit [Ping timeout: 245 seconds]
munga has joined #ocaml
xlq has joined #ocaml
<xlq> What's the best way to store position information with each token when using ocamllex/ocamlyacc? It seems a rather obvious and common thing to do, yet it doesn't seem that obvious how to do it.
Tobu has quit [Ping timeout: 260 seconds]
<Ptival> can I magic-ally look inside a closure to get back one of its parameters?
<Ptival> (for debug purposes, not for real code)
munga has quit [Ping timeout: 276 seconds]
<mrvn> Ptival: Obj.magic doesn't seem to have functions for it I think.
<mrvn> But that's where they would be.
<diml> Obj.field (Obj.repr func) (param_number + 1)
<mrvn> diml: is that documented somewhere that functions are layed out that way?
<diml> i don't know
<Ptival> 0-based?
<xlq> Must I parameterise all my tokens by Lexing.position?
<diml> Ptival: yes, Obj.field (Obj.repr func) 0 is the code of the function
<Ptival> diml: oh, so parameters begin at 1
Tobu has joined #ocaml
Tobu has quit [Changing host]
Tobu has joined #ocaml
<mrvn> let arg f n = Obj.obj (Obj.field (Obj.repr f) (n+1))
<mrvn> let int_arg f n = ((arg f n) : int)
<mrvn> # int_arg (( + ) 5) 1;;
<mrvn> - : int = 5
andreypopp has joined #ocaml
<mrvn> You need some phantom type or GADT to make that type save.
<mrvn> Ptival: aparently args begin at 2.
iago has quit [Ping timeout: 252 seconds]
<Ptival> keep segfaulting :(
munga has joined #ocaml
<mrvn> huh?
<Ptival> huh
<mrvn> what segfaults?
<Ptival> I had to pass it a 5 to get the right thing :\
<mrvn> Maybe arguments are listed in reverse order?
<mrvn> as in the stack grows down
<Ptival> oh no, sometimes it segs
<mrvn> You should check the size of the block
<mrvn> # let f a b c d e f g h i j = a + b + c + d + e + f + g + h + i + j;;
<mrvn> # for i = 1 to 10 do Printf.printf "%d " (arg (f 1 2 3 4 5 6 7 8 9 10) i); done;;
<mrvn> 1 2 3 4 5 6 7 8 9 10 - : unit = ()
<mrvn> seems to be in order on amd64.
<mrvn> Ptival: bytecode or cbinary?
<mrvn> -c
<Ptival> binary
<mrvn> and is the function curried? function x -> let foo = something in function y -> ... might look totaly different.
<Ptival> let transf c n result = ...
emmanuelux has joined #ocaml
<Ptival> trying to get the c out of (transf f0.fn_code)
<mrvn> Do more checks, like check the size of the block etc.
iago has joined #ocaml
<Ptival> weird, it works well for a bit then fails
<Ptival> anyway... debugging that involves a circular dependency
fraggle_laptop has joined #ocaml
<hcarty> xlq: Something along those lines. I've only used ocamllex a bit, but I remember needing to rather liberally store token positions.
<xlq> Hmm.
<xlq> Oh well.
<hcarty> My limited experience with ocamllex involves modifying the xstrp4 syntax extension - http://0ok.org/cgit/cgit.cgi/xstrp4/tree/src/xstrp4_lexer.mll
emmanuelux has quit [Remote host closed the connection]
Tobu has quit [Ping timeout: 260 seconds]
xlq has quit [Ping timeout: 260 seconds]
xlq has joined #ocaml
fraggle_laptop has quit [Read error: Connection reset by peer]
fraggle_laptop has joined #ocaml
Tobu has joined #ocaml
snearch has joined #ocaml
smondet has joined #ocaml
iago has quit [Quit: Leaving]
sodomutilator has joined #ocaml
sodomutilator has quit [Client Quit]
mika1 has left #ocaml []
cago has quit [Quit: Leaving.]
snearch has quit [Quit: Verlassend]
<hcarty> diml: Another lwt/zmq question - the Lwt_unix.Retry exception escapes Lwt_unix.wrap_syscall. What could cause that to happen?
skchrko has joined #ocaml
skchrko has quit [Client Quit]
pangoafk is now known as pango
<diml> hcarty: i don't know, i can have a look if you give me an example that shows the problem
<hcarty> diml: I can in a minute or few...
<hcarty> diml: Code - http://vpaste.net/SG7Tt
<hcarty> diml: _tags -
<hcarty> Built with 'ocamlbuild -use-ocamlfind foo.native'
skchrko has joined #ocaml
<hcarty> './foo.native' runs without using Lwt; './foo.native lwt' runs using Lwt
djcoin has quit [Quit: WeeChat 0.3.2]
Xizor has joined #ocaml
JuzorBNC is now known as Juzor
silver has quit [Remote host closed the connection]
albacker has quit [Quit: Leaving]
cdidd has quit [Remote host closed the connection]
<xlq> Can I define a new name for the same type (like "typedef")?
<xlq> I tried "type t = Some_package.t" in my mli (and duplicated in the corresponding ml file), but when I use Some_package.Some_constructor they act as if incompatible.
<diml> hcarty: it is a bug in Lwt_unix (a try instead of a try_lwt). Add ~blocking:false to of_unix_file_descr and it will work
<hcarty> xlq: If you want the constructors too you either need to include the full type definition
<xlq> Oh, never mind, it turned out that the error was elsewhere.
Tobu has quit [Ping timeout: 260 seconds]
<hcarty> xlq: Oops, I misread your message...
<hcarty> diml: Thank you, I'll give it a shot. Should I report this somewhere?
<hcarty> diml: Or has it already been fixed? :-)
<diml> hcarty: it will be fixed in 5 minutes
<hcarty> diml: Thank you for the work-around. I tested it and it works here.
Tobu has joined #ocaml
<diml> hcarty: note that it is not a workaround, when you know that the fd support non-blocking, it is faster to tell it to lwt_unix
<ezyang> Say I have a standalone Ocaml application that I would like to libify, so that I can use its internal functions in another app. How would I go about doing this?
<hcarty> diml: Oh, I see. Even better.
<ezyang> (the application in question is Coq)
<hcarty> ezyang: Pull the functions, types, etc. you want to put in a library into their own modules. Then get those modules to compile on their own.
<ezyang> hcarty: Hm, that'll be too invasive :-(
<ezyang> Is there an easy way to just say, "Hey, all of these modules are includeable!"
<Drakken> ezyang the main module contains top-level expressions. You need to exclude those to make a library.
<ezyang> Hm, I see.
<ezyang> Assuming that those are excluded, what's the next step?
<Drakken> ocamlc -c
<hcarty> Or ocamlbuild lib.cma lib.cmxa
Submarine has joined #ocaml
Submarine has quit [Changing host]
Submarine has joined #ocaml
Submarine has quit [Read error: Connection reset by peer]
<Drakken> ocamlc -a to put your object files together into a library, or make a .mllib file to use ocamlbuild.
<Drakken> What's the standard way of faking first-class object methods?
<Drakken> a hashtable?
<Drakken> I can't think of anything else that would be extendable.
<mrvn> so you can do object#call "name"?
<Drakken> right
<mrvn> have fun coming up with some phatom types to add type safety to that and to allow object#call "name" arg1 arg2
<mrvn> FYI hashing is what ocaml does for object methods
<mrvn> I think you could use a hash variant type (`Name) and method call = function `Foo -> .. | `Bar -> ... | _ -> raise Unknown_method
<mrvn> (which will be a hashtbl in the end too)
<Drakken> well, if it's good enough for ocaml.....
<hcarty> diml: Is it possible to enable Lwt backtraces when using ocamlbuild?
<diml> hcarty: you have to create a myocamlbuild.ml
<mrvn> The alternative would be a tree of some sort but that would be O(log n) instead of O(1).
<mrvn> or a simple list O(n)
<mrvn> One advantage over hashing strigs yourself would be that ocaml notices hash collisions on `Name.
fraggle_laptop has quit [Remote host closed the connection]
<Drakken> maybe you could just store functions in slots.
ulfdoz has joined #ocaml
ulfdoz has quit [Ping timeout: 246 seconds]
<hcarty> diml: Is it harmful to enable the debug flag and OCaml's own backtraces when using Lwt?
munga has quit [Ping timeout: 248 seconds]
<thelema> Drakken: Why do you want to roll your own objects?
<mrvn> .oO(implementing python in ocaml)
<hcarty> diml: I'm not sure why this is the case, but if I create zeromq sockets within Lwt_main.run they don't work properly. However, if Lwt_main.run is called within the context of existing zeromq sockets then everything works properly.
<hcarty> diml: Do you have any idea why this may be true?
<Drakken> thelema come to think of it, I may not have to. I want to be able to add functionality to existing functionality, but maybe it's better to use modules and inherit existing functionality by including other modules.
<diml> haelix: for backtraces: not it is not harmful
<mrvn> Drakken: or simply inherit the object and overload the method.
<Drakken> I need higher-order methods.
<diml> hcarty: what do you mean they don't work properly ?
<mrvn> Drakken: like?
<Drakken> mrvn like parser combinators.
<hcarty> diml: zeromq throws errors about invalid sockets when a socket was created within Lwt_main.run
andreypopp has quit [Quit: ["Textual IRC Client: www.textualapp.com"]]
<thelema> Drakken: you can have polymorphic methods - how high an order do you need?
<mrvn> thelema: the non-typable kind. :)
<thelema> meh. You don't need those, you want those. you'll write your code without them and be happy. :P
<diml> hcarty: i have no idea, could you give me an example ?
<Drakken> thelema the object thing may have been overkill. I just need a simple way to extend clumps of functionality.
<mrvn> Drakken: at compile time or run time?
<Drakken> compile time is probably fine.
<mrvn> you can use first class modules instead of object
<Drakken> mrvn whatever. I just want to get some code working that's easy to extend.
<Drakken> thelema how many orders are there? Polymorphism is good, but I also need to combine other functions together.
<Drakken> (parsers)
emmanuelux has joined #ocaml
err404 has joined #ocaml
<thelema> I think there's theoretically no limit to orders, but only orders 0-2 are used - order 0 is not-polymorphic (int list), order 1 is what ocaml has ('a list), and IIRC haskell has order 2 ('a 'b)
<mrvn> thelema: can't you emulate second order wiht ('a, 'b)?
<thelema> mrvn: I don't see how that could emulate an unknown container type
<thelema> for example, sorting code that works for (int 'a) i.e. int list, int array, int vector, etc.
<mrvn> How does haskell match a type foo bar baz buzz to 'a 'b?
<thelema> I'm not a haskell user, so I don't know.
<mrvn> thelema: yeah, that is the problem. It would be type (int, 'a) with a constraint that 'a = int 'b.
<mrvn> I have the feeling you could GADTs to add a witness type to ('a, 'b) to say that 'b = 'a 'c.
<mrvn> But that probably only covers some simple cases.
xlq has quit [Ping timeout: 260 seconds]
<hcarty> diml: I'll try to get something minimal together. This one has been more difficult to reproduce effectively.
Skolem has quit [Quit: Skolem]
smerz has joined #ocaml
Submarine has joined #ocaml
Submarine has quit [Changing host]
Submarine has joined #ocaml
andreypopp has joined #ocaml
albacker has joined #ocaml
albacker has quit [Changing host]
albacker has joined #ocaml
eikke has quit [Ping timeout: 250 seconds]
skchrko has quit [Quit: ChatZilla 0.9.88.1 [Firefox 11.0/20120314111819]]
skchrko has joined #ocaml
shachaf has quit [Ping timeout: 245 seconds]
shachaf has joined #ocaml
Submarine has quit [Ping timeout: 264 seconds]
skchrko_ has joined #ocaml
skchrko has quit [Ping timeout: 265 seconds]
skchrko_ is now known as skchrko
Tobu has quit [Ping timeout: 272 seconds]
eikke has joined #ocaml
skchrko has quit [Remote host closed the connection]
Tobu has joined #ocaml
NihilistDandy has joined #ocaml
err404 has quit [Quit: Ex-Chat]
eikke has quit [Ping timeout: 248 seconds]
NihilistDandy has quit []
Juzor is now known as JuzorBNC
Xizor has quit []
smondet has quit [Remote host closed the connection]
albacker has quit [Ping timeout: 246 seconds]
ASau` has quit [Ping timeout: 246 seconds]
snarkyboojum has quit [Quit: ...]
<ousado> is there an ocaml 'object' database that support records tuples and datatypes?
<mrvn> a what suporting what?
<ousado> a database for plain ocaml types
<mrvn> what should that database be?
<ousado> 'be'?
<mrvn> what do you want to do?
<ousado> I'm writing a kind of database generator
<ousado> for haxe, currently
<ousado> haxe also has ADTs
<ousado> and I'm thinking about an interfaces for them
<ousado> *interface
<ousado> it's an in-memoty database backed by mmapped files