gildor changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | OCaml 3.12.0+beta1 http://permalink.gmane.org/gmane.comp.lang.caml.inria/49168
Edward__ has joined #ocaml
th5 has joined #ocaml
th5 has quit [Client Quit]
avsm has quit [Quit: Leaving.]
metasyntax has joined #ocaml
mbishop has quit [Ping timeout: 248 seconds]
jonafan_ has joined #ocaml
jonafan has quit [Ping timeout: 272 seconds]
Edward__ has quit []
mbishop has joined #ocaml
alexyk has joined #ocaml
<alexyk> Hi -- I need to convert the following JSON into a structure of the type: (string, (int, (string, int) Hashtbl.t) Hashtbl.t) Hashtbl.t: "{\"9\":{\"jovenatheart\":1},\"10\":{\"beverlyyanga\":1},\"31\":{\"mcshellyshell\":1}}" -- how do I do that with Json_wheel/static?
<alexyk> actually, into: (int, (string, int) Hashtbl.t) Hashtbl.t
ftrvxmtrx has quit [Read error: Connection reset by peer]
jeddhaberstro has quit [Quit: jeddhaberstro]
<thelema> alexyk: using json-wheel, you'll get a value of type Json_type.t
<thelema> It looks like you can use the Json_type.Browse functions to convert this into your desired type...
joewilliams is now known as joewilliams_away
<thelema> or not - json_type hashtables can only be indexed by strings... so you'll get a (string, (string, int) Hashtbl.t) Hashtbl
ftrvxmtrx has joined #ocaml
<thelema> let to_alexyk_t = open Json_type.Browse in objekt |- make_table |- Hashtbl.map (objekt |- make_table |- Hashtbl.map int)
<thelema> |- and Hashtbl.map from batteries
<alexyk> what's |- ? F#'s |> ?
<thelema> almost - it's the point free version.
<thelema> let ( |- ) f g x = g (f x)
<alexyk> is Hashtbl.map not in the standard Hashtbl?
<thelema> nope
<alexyk> thelema: I guess it's time to install them then :)
<alexyk> thelema: from your github is stable enough?
<alexyk> thelema: how do I use batteries from the toplevel?
<alexyk> thelema: can't build on Mac OS from github checkout: + ocamlfind ocamlopt -shared -linkall -package camomile,num,str -o src/batteries_uni.cmxs src/batteries_uni.cmxa
<alexyk> ld: warning: -read_only_relocs cannot be used with x86_64
<alexyk> ld: codegen problem, can't use rel32 to external symbol _caml_negf_mask in .L101 from src/batteries_uni.a(batFloat.o)
<thelema> you can't build the shared target - try BATTERIES_NATIVE_SHLIB=no make
<thelema> you can use batteries from the toplevel by adding the ocamlinit lines we provide into your ~/.ocamlinit file
<thelema> batteries from github is reasonably stable
<alexyk> thelema: so on Mac, I can't build the shared target?
<thelema> apparently not. I dunno the problem of building shared libraries on mac
mbishop has quit [Ping timeout: 276 seconds]
mbishop has joined #ocaml
thrasibule has joined #ocaml
mbishop has quit [Ping timeout: 240 seconds]
mbishop has joined #ocaml
gl has quit [Ping timeout: 264 seconds]
<alexyk> thelema: so is json_wheel part of batteries?
<thelema> alexyk: no, it's separate
<thelema> the only outside library for batteries is camomile (and findlib, but maybe we can assume that)
<alexyk> thelema: command-line history doesn't work?
<thelema> rlwrap ocaml
<alexyk> ok... I was using an in-repl library
<alexyk> so there's no conflict
<thelema> depends on how that library loads. You may have to merge .ocamlinit files instead of just copying
<alexyk> thelema: what can go wrong if I don't have the shared library for batteries?
<alexyk> I'm there, works! cute ASCII graphics :)
<thelema> I think very little - I don't use the shared library feature.
<thelema> yay!
<alexyk> thelema: I get a parse error on = in: let to_alexyk_t = open Json_type.Browse in objekt |- make_table |- Hashtbl.map (objekt |- make_table |- Hashtbl.map int)
<alexyk> Parse error: [expr] expected after "=" (in [fun_binding])
<thelema> try moving the "open Json_type.Browse" outside the expression
<alexyk> ok
<thelema> I just made up that code - I didn't test it at all.
<thelema> and to be honest, I've not used the local open in syntax yet - I thought that was available in 3.11, but maybe I got it wrong.
<alexyk> doesn't work still without open
<thelema> the open works?
<alexyk> yep
<thelema> maybe the argument order is wrong on hashtbl.map...
<thelema> no, it seems right...
<thelema> what's the error? type error?
<alexyk> why does it now say value a = ... instead of the previous val a = ...?
<alexyk> let to_alexyk_t = objekt |- make_table |- Hashtbl.map (objekt |- make_table |- Hashtbl.map int)
<alexyk> Error: Parse error: [expr] expected after "=" (in [fun_binding])
<thelema> really? odd...
<alexyk> can we do point-free like that?
<thelema> well, let's get explicit:
<thelema> let to_ht v = objekt v |> make_table |> Hashtbl.map (fun h1 -> objekt h1 |> make_table |> Hashtbl.map int)
<alexyk> getting closer: Error: This expression has type Json_type.t -> int
<alexyk> but an expression was expected of type Json_type.t -> 'a -> 'b
<alexyk> on the last int
<thelema> hmmm... ah, that's the problem, hashtbl.map uses two arguments for its function
<thelema> let to_ht v = objekt |- make_table in
<thelema> let to_alexyk_t = to_ht |- Hashtbl.map (fun k v -> to_ht v |> Hashtbl.map (fun k v -> int v))
<alexyk> are you sure we need v in let to_ht v = ...?
<thelema> no, that's a mistake
<alexyk> Error: Parse error: "in" expected after [binding] (in [expr]) -- on the last )
<thelema> yes, that's just the toplevel issue with my misuse of in
<thelema> drop all the [in]s, just define both at the toplevel
<thelema> (not nested, as the in would indicate
<alexyk> ok... I've not used OCaml for 1.5 years, learned Scala. Clojure and Haskell since then, and now am a bit mixed up :) but it all starts coming back
<alexyk> wow, all works! thanks!
<thelema> you're welcome.
<alexyk> however,m I want the first string to also convert to int
<thelema> For that, you may want to... use Enum.
<alexyk> is Enum shorter than int? I have 35 possible values there
mbishop has quit [Ping timeout: 264 seconds]
<thelema> let to_alexyk_t = objekt |- List.enum |- Enum.map (fun (k,v) -> int_of_string k, (to_ht v |> Hashtbl.map (ignore |- int))) |- Hashtbl.of_enum
<thelema> Enum is like lazy list but different internally - no going back.
<thelema> Enum isn't for holding a number.
<alexyk> hmm
<thelema> Hashtbl.map can't change the keys
<alexyk> I can just convert the string to int no?
<alexyk> so I need to create it with an int os string
<alexyk> of
<thelema> yes, but you have to do that before building the hashtable, and make_table only makes hashtables keyed on string
<alexyk> ah... so I'd have to work the objekt differently
thrasibule has quit [Ping timeout: 265 seconds]
<thelema> yup.
mbishop has joined #ocaml
caligula__ has joined #ocaml
caligula_ has quit [Ping timeout: 260 seconds]
bacam has joined #ocaml
alexyk has quit [Quit: alexyk]
pad has quit [Remote host closed the connection]
pad has joined #ocaml
emmanuelux has quit [Remote host closed the connection]
ttamttam has joined #ocaml
valross has quit [Quit: Ex-Chat]
ttamttam has quit [Quit: Leaving.]
Amorphous has quit [Ping timeout: 248 seconds]
Amorphous has joined #ocaml
ygrek has joined #ocaml
ttamttam has joined #ocaml
segmond has quit [Quit: Leaving]
ftrvxmtrx has quit [Ping timeout: 252 seconds]
filp has joined #ocaml
ztfw` has joined #ocaml
det has quit [Remote host closed the connection]
ztfw has quit [Ping timeout: 252 seconds]
coucou747 has joined #ocaml
myu2 has joined #ocaml
myu2 has quit [Remote host closed the connection]
myu2 has joined #ocaml
ygrek has quit [Ping timeout: 245 seconds]
ikaros has joined #ocaml
ikaros has quit [Remote host closed the connection]
ikaros has joined #ocaml
pad has quit [Remote host closed the connection]
ftrvxmtrx has joined #ocaml
seafood has joined #ocaml
Yoric has joined #ocaml
boscop has joined #ocaml
boscop_ has joined #ocaml
boscop_ has quit [Read error: Connection reset by peer]
boscop has quit [Ping timeout: 265 seconds]
boscop has joined #ocaml
ygrek has joined #ocaml
thomasga has joined #ocaml
Edward__ has joined #ocaml
seafood_ has joined #ocaml
seafood has quit [Ping timeout: 245 seconds]
seafood_ is now known as seafood
ulfdoz has quit [Ping timeout: 260 seconds]
ygrek has quit [Ping timeout: 245 seconds]
ikaros has quit [Quit: Leave the magic to Houdini]
myu2_ has joined #ocaml
myu2__ has joined #ocaml
myu2 has quit [Ping timeout: 276 seconds]
myu2_ has quit [Ping timeout: 258 seconds]
f[x] has quit [Ping timeout: 240 seconds]
f[x] has joined #ocaml
sepp2k has joined #ocaml
myu2__ has quit [Remote host closed the connection]
caml_simon has joined #ocaml
ygrek has joined #ocaml
_andre has joined #ocaml
prince has quit [Quit: 전 이만 갑니다.]
myu2 has joined #ocaml
caml_simon has left #ocaml []
Yoric has quit [Read error: Connection reset by peer]
Yoric has joined #ocaml
boscop has quit [Read error: Connection reset by peer]
boscop has joined #ocaml
thrasibule has joined #ocaml
filp has quit [Quit: Bye]
ttamttam has quit [Quit: Leaving.]
seanmcl has joined #ocaml
_unK has joined #ocaml
Edward__ has quit []
iratsu has quit [Read error: Operation timed out]
jcaose_ has joined #ocaml
iratsu has joined #ocaml
jonafan has joined #ocaml
jonafan_ has quit [Ping timeout: 264 seconds]
ttamttam has joined #ocaml
iratsu has quit [Ping timeout: 240 seconds]
metasyntax` has joined #ocaml
iratsu has joined #ocaml
iratsu has quit [Ping timeout: 260 seconds]
Edward__ has joined #ocaml
ikaros has joined #ocaml
ccasin has joined #ocaml
Edward__ has quit []
ttamttam has quit [Quit: Leaving.]
iratsu has joined #ocaml
iratsu has quit [Ping timeout: 276 seconds]
iratsu has joined #ocaml
iratsu has quit [Ping timeout: 252 seconds]
joewilliams_away is now known as joewilliams
iratsu has joined #ocaml
iratsu has quit [Ping timeout: 240 seconds]
ygrek has quit [Ping timeout: 245 seconds]
iratsu has joined #ocaml
seanmcl has quit [Quit: seanmcl]
eck has joined #ocaml
iratsu has quit [Ping timeout: 240 seconds]
Edward__ has joined #ocaml
seanmcl has joined #ocaml
iratsu has joined #ocaml
sepp2k has quit [Remote host closed the connection]
avsm has joined #ocaml
ygrek has joined #ocaml
avsm has quit [Quit: Leaving.]
ftrvxmtrx has quit [Quit: Leaving]
emmanuelux has joined #ocaml
sshc has quit [Ping timeout: 240 seconds]
svenl has quit [Ping timeout: 240 seconds]
ygrek has quit [Ping timeout: 245 seconds]
svenl has joined #ocaml
Yoric has quit [Remote host closed the connection]
Yoric has joined #ocaml
sepp2k has joined #ocaml
eck has left #ocaml []
ttamttam has joined #ocaml
f[x] has quit [Ping timeout: 240 seconds]
sshc has joined #ocaml
Edward__ has quit []
ftrvxmtrx has joined #ocaml
ygrek has joined #ocaml
seanmcl has quit [Quit: seanmcl]
seanmcl has joined #ocaml
seanmcl has quit [Quit: seanmcl]
seanmcl has joined #ocaml
seanmcl has quit [Client Quit]
travisbrady has joined #ocaml
Yoric has quit [Quit: Yoric]
sepp2k1 has joined #ocaml
sepp2k has quit [Ping timeout: 265 seconds]
seanmcl has joined #ocaml
iratsu has quit [Ping timeout: 240 seconds]
alexyk has joined #ocaml
<alexyk> what package do I need to link and what open statement should I add to use batteries, things like |>, |-, Batteries.Hashtbl, etc.?
<mfp> package batteries
<mfp> the operators are in BatPervasives
<alexyk> mfp: so I open BatPervasives?
<mfp> so you can either open Batteries and use everything directly (Hashtbl is BatHashtbl, etc.)
<mfp> or open BatPervasives to get (|>) and friends, but then you have to refer to other things as BatHashtbl etc.
<alexyk> mfp: ah, so if I just say open Batteries, I get it all? no extra opens needed?
<mfp> the latter allows you to control what's linked exactly
<mfp> yes, [open Batteries] gives you everything
<mfp> note that it's open Batteries_uni if you're not compìling with -thread (AFAICS)
hcarty has left #ocaml []
hcarty has joined #ocaml
<alexyk> mfp: cool! just checked out your blog -- there's a gap from July 2009 to now with impressive ocamlmq. Did you try other languages in between?
iratsu has joined #ocaml
julm has quit [Quit: leaving]
julm has joined #ocaml
<alexyk> mfp: wow, very interesting benchmarks on hashtbl competitors. Does it mean there's an incentive to switch to a newer version of a better Hashtbl?
mbac has quit [Quit: Reconnecting]
mbac has joined #ocaml
julm has quit [Quit: leaving]
<alexyk> mfp: is there anything easily adatpable to real google protocol buffers for ocaml?
avsm has joined #ocaml
sepp2k1 has quit [Quit: Leaving.]
Yoric has joined #ocaml
ChristopheT has joined #ocaml
iratsu has quit [Ping timeout: 240 seconds]
julm has joined #ocaml
metasyntax` has quit [Quit: Be seeing you.]
alexyk has quit [Quit: alexyk]
ttamttam has quit [Quit: Leaving.]
alexyk has joined #ocaml
<alexyk> mfp: missed replies, if any :)
avsm has quit [Quit: Leaving.]
alexyk has quit [Quit: alexyk]
mbac has quit [Quit: leaving]
_unK has quit [Remote host closed the connection]
alexyk has joined #ocaml
<bitbckt> I'm attempting to parse some JSON (using json-static) that includes the word "type" as an attribute. Any idea how I could use that in my json type definition?
Amrykid has joined #ocaml
<flux> pretty sure that hadn't occurred in the author's mind :)
<flux> perhaps you can extend the extension further, to support alternate JSON-spellings to a field..
<bitbckt> That's on the "Plan C" list.
<flux> :)
<bitbckt> (I'm at "Plan B: Ask on IRC", right now)
<flux> plan A was, it simply works?
<bitbckt> Pretty much. :-)
<bitbckt> It seemed to be a loophole in the lib, when I checked the docs.
ygrek has quit [Remote host closed the connection]
emmanuelux has quit [Quit: =>[]]
<bitbckt> But I was hoping the original author had thought of some magic I wasn't aware of.
emmanuelux has joined #ocaml
<bitbckt> Time to go extension hacking, I guess.
<adrien> regexp search-and-replace?
<flux> well, if there is, there might be one (undocumented) in the source
<adrien> someone really need to drop the +R from the channel modes
<bitbckt> adrien: Hmm. That's an idea - sanitize the input, first.
_andre has quit [Quit: leaving]
<adrien> and edit the output too
<adrien> how much data do you have to deal with?
<bitbckt> I don't have to emit JSON.
<bitbckt> So that's not an issue.
<bitbckt> Peak usage is around 3000 messages per second, right now.
<bitbckt> And gaining. :-)
<bitbckt> A "message" in this context being a JSON data structure I need to process.
<adrien> I guess it should do it for now, should give you some time to find a better solution
<adrien> (and, quite nice =) )
<bitbckt> Yes, it could work as a temporary solution.
<bitbckt> I'll put that in "Plan D" ;)
Amrykid has left #ocaml []
jlouis has quit [Quit: leaving]
jlouis has joined #ocaml
alexyk has quit [Quit: alexyk]
myu2 has quit [Remote host closed the connection]
Associat0r has joined #ocaml
ikaros has quit [Quit: Leave the magic to Houdini]
Yoric has quit [Quit: Yoric]
seafood has quit [Quit: seafood]
rwmjones has left #ocaml []
boscop has quit [Ping timeout: 276 seconds]
boscop has joined #ocaml
boscop_ has joined #ocaml
boscop__ has joined #ocaml
boscop has quit [Ping timeout: 240 seconds]
boscop_ has quit [Read error: Connection reset by peer]
boscop__ has left #ocaml []
boscop has joined #ocaml
murph has quit [Remote host closed the connection]
ChristopheT has quit [Ping timeout: 265 seconds]
thieusoai has quit [Quit: Leaving]
Edward__ has joined #ocaml
alexyk has joined #ocaml
psnively has joined #ocaml