ChanServ changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | http://www.ocaml.org | OCaml 4.01.0 announce at http://bit.ly/1851A3R | Logs at http://irclog.whitequark.org/ocaml
marky_ is now known as marky
marky has quit [Changing host]
marky has joined #ocaml
marky has left #ocaml [#ocaml]
flx has joined #ocaml
flx is now known as Guest79627
zpe has quit [Remote host closed the connection]
agarwal1975 has quit [Read error: Connection reset by peer]
flux has quit [Ping timeout: 256 seconds]
travisbrady has quit [Quit: travisbrady]
agarwal1975 has joined #ocaml
izaak has joined #ocaml
tobiasBora has quit [Quit: Konversation terminated!]
jerith has quit [Ping timeout: 245 seconds]
Algebr has joined #ocaml
vervic has quit [Remote host closed the connection]
shinnya has quit [Ping timeout: 250 seconds]
arjunguha has joined #ocaml
jwatzman|work has quit [Quit: jwatzman|work]
arjunguha has quit [Quit: My MacBook has gone to sleep. ZZZzzz…]
<Algebr> is the fun keyword interchangable with function at all times? List.map ({fun, function} n -> n * 2) [1;2;3;]
<izaak> Algebr: I wouldn't say it's interchangable exactly. function allows one to pattern match
<izaak> eg., let hd = function x :: xs -> Some x | [] -> None
<Algebr> but just fun wouldn't work there?
<izaak> which is equivalent to let hd = fun l -> match l with x :: xs -> Some x | [] -> None
<companion_cube> fun can take several arguments, function cannot
<companion_cube> but function performs a pattern matching
<izaak> in general "function p1 -> t1 | ... | pn -> tn" is equivalent to "fun x -> match x with p1 -> t1 | ... | pn -> pn"
<izaak> *should be tn at the end there
<Algebr> noted.
clog_ has quit [Quit: ^C]
clog has joined #ocaml
oriba_ has quit [Quit: oriba_]
jao has joined #ocaml
jao has quit [Changing host]
jao has joined #ocaml
freling has quit [Ping timeout: 256 seconds]
mcclurmc has quit [Read error: Connection reset by peer]
mcclurmc has joined #ocaml
freling has joined #ocaml
penglingbo has joined #ocaml
izaak has quit [Ping timeout: 272 seconds]
<Algebr> So <- is an expression which presumably has return type of unit? but if <- is an expression, why can't I get the type of it within utop, tried ( <- ), is <- then syntax?
<companion_cube> it is a builtin operator
<Algebr> right, but so is + and ( + ) works.
Natch has joined #ocaml
<companion_cube> it's deeper than that, I think
<companion_cube> <- is the only source of mutability in OCaml
<Algebr> companion_cube: does't := also mutate?
<companion_cube> := is sugar ;)
<companion_cube> basically it could be let (:=) r x = r.content <- x
<Algebr> ah, because refs are just single field records?
jao has quit [Remote host closed the connection]
<companion_cube> yes
<companion_cube> look in pervasives.ml
<Algebr> if everyone is using campl4, then why isn't that just offical syntax ?
<Drup> what is ?
<Drup> also, not everyone uses it
<Algebr> oh that was just a formatting error, just a question mark puncatation.
<Drup> also, until the next version, camlp4 is part of the official distribution
<Algebr> does imperative code come up frequently in out in the wild ocaml code?
jao has joined #ocaml
jao has quit [Changing host]
jao has joined #ocaml
eikke__ has joined #ocaml
badon_ has joined #ocaml
badon has quit [Ping timeout: 240 seconds]
<Drup> I would say yes
<Algebr> So stuff that looks like, [< foo = bar >] , that's just a syntax extension via camlp4?
<Drup> probably
<Drup> (it looks like it, at least)
badon_ is now known as badon
ygrek has joined #ocaml
<Algebr> but stuff that is [< `Foo | `Bar], that's part of the language proper
<Drup> what code are you looking at ?
<Drup> yes
omqal has joined #ocaml
<Algebr> I'm going through the reference manual, page 22
<Drup> but it's a type expression :)
<Drup> note that {< foo = bar >} is not a syntax extension
<Drup> (it's functionnal self update of an object)
<Algebr> ah, I don't know anything about ocaml objects yet.
<Algebr> been trying to keep that off in the distance.
<Drup> you are probably right, they aren't used a lot in ocaml
<Drup> (except for the occasional type trickery)
badon has quit [Ping timeout: 264 seconds]
q66_ has quit [Quit: Leaving]
badon has joined #ocaml
freling has quit [Ping timeout: 256 seconds]
zarul has quit [Ping timeout: 256 seconds]
eikke__ has quit [Ping timeout: 260 seconds]
freling has joined #ocaml
englishm has joined #ocaml
badon has quit [Ping timeout: 255 seconds]
badon has joined #ocaml
zpe has joined #ocaml
<Algebr> Why doesn't merlin plan to support camlp4?
zpe has quit [Ping timeout: 260 seconds]
<Drup> probably because it's basically impossible
<Algebr> why is it basically impossible/
<Drup> merlin is parsing and typechecking incrementally
<Drup> and use a modified type checker to retrieve informations on the syntax even if typechecking a a whole fails
<Drup> as*
<Drup> camlp4 works on complete file, it's not incremental
<Algebr> ah, makes sense.
<Drup> also, another reason, is that camlp4 is going to be far less used with the arrival of ppx
<Drup> and I'm not sure how responsive merlin would be with a camlp4 overlay, since camlp4 is slow as fuck >_>
<Drup> (and finally, camlp4 is a undocumented mess and I would understand if def` wanted to say the hell away from it :D)
omqal has quit [Quit: omqal]
ollehar1 has quit [Ping timeout: 256 seconds]
hhugo1 has quit [Quit: Leaving.]
zpe has joined #ocaml
sad0ur has quit [Ping timeout: 250 seconds]
zpe has quit [Ping timeout: 240 seconds]
philtor has quit [Ping timeout: 245 seconds]
jao has quit [Ping timeout: 245 seconds]
ousado has joined #ocaml
ousado_ has quit [Ping timeout: 240 seconds]
<Drup> whitequark: did you tried to do Read ?
xenocons has quit [Remote host closed the connection]
<Drup> well, not around Some, but "Some (foo)"
penglingbo has quit [Ping timeout: 255 seconds]
Algebr has quit [Ping timeout: 260 seconds]
araujo has quit [Quit: Leaving]
zpe has joined #ocaml
zpe has quit [Ping timeout: 260 seconds]
<whitequark> Drup: not yet
<whitequark> yes, I do need to put parentheses...
<Drup> I was just working on something and though "hum, I need some serialization where I can catch failure"
<Drup> (so no Marshal)
<Drup> and then tried to use Scanf
<Drup> and then I remember the last time I tried, and it was already a terrible idea back then
englishm has quit [Remote host closed the connection]
englishm has joined #ocaml
<whitequark> do you need cyclic structures?
<Drup> no
<whitequark> then you can wait for a bit and get json or sexp
<Drup> I'm not sure the lambda-term is willing to take json/sexp as a dependency
<Drup> +maintaner
<whitequark> oh
<whitequark> hm
<whitequark> what's the use case?
<Drup> You're going to cry tears of blood, are you ready ?
<Drup> so, I'm reimplementing little ocp-browser in a sensible (and more featureful) way using lambda-term instead of ncurse (because ncurse is pure crap)
<Drup> ocp-index uses Format to format the output informations
<Drup> so I need a coloration way that works with Format
<Drup> which means tags
<Drup> tags are integers
<Drup> tags are strings*
<Drup> so I need to serialize the style in a string, pass it though the tag ugly interface of formats, register a tagging function which will unserialize it and apply the style
<Drup> (trust me, it's the only way, I've tried everything else)
axiles has joined #ocaml
<Drup> and I would like to submit my format interface for LTerm_text upstream, because it's actually quite nice, but it implies using something that is resilient to someone who will put something I won't parse in a tag
<Drup> (or at least, fail with something else than a segfault)
<whitequark> I... do not see anything anymore, the blood prevents that
<Drup> :D
<whitequark> but seriously, yes, I see the case, and I understand the trouble with Format
<whitequark> and yes, Read would solve this
<Drup> yes
<whitequark> does this mean you would add a >=4.02 dependency to lambda-term?
<Drup> doubteful, since lambda-term supports utop
<Drup> but the question was more of "how are you going to implement it ?"
<Drup> (seriously, the tag interface in format is really horrible)
<Drup> (a simple type parameter, and I would have something more efficient and type-safe)
zpe has joined #ocaml
englishm has quit [Ping timeout: 256 seconds]
<whitequark> I'd use Scanf, yes
morphles has joined #ocaml
<Drup> well, I wonder how you are going to do variants
<Drup> because, disjunction in scanf ... I really don't know how to do it in a sane way
<whitequark> read a word, match on it
zpe has quit [Ping timeout: 240 seconds]
<whitequark> it's the same for record fields, I guess?
<Drup> meh
ygrek has quit [Ping timeout: 264 seconds]
<Drup> whitequark: also, for info. in ocp-browser, I don't need arbitrary styles, so I just put the few styles I needed in an hashtbl and be done with it.
<whitequark> I see
<Drup> I'm not that masochist :D
<whitequark> you aren't?
<Drup> :p
<whitequark> Drup: oh, btw, no parens in Show needed
<whitequark> because I print tuples with (,,,)
<whitequark> no way that could result in ambiguity
<Drup> and constructors ?
<whitequark> crap.
<Drup> :D
fraggle_ has quit [Remote host closed the connection]
fraggle_ has joined #ocaml
Simn has joined #ocaml
fraggle_ has quit [Remote host closed the connection]
fraggle_ has joined #ocaml
zpe has joined #ocaml
zpe has quit [Ping timeout: 240 seconds]
Kakadu has joined #ocaml
sad0ur has joined #ocaml
zarul has joined #ocaml
zarul has quit [Max SendQ exceeded]
studybot has joined #ocaml
zarul has joined #ocaml
zarul has joined #ocaml
zarul has quit [Changing host]
NoNNaN has joined #ocaml
ggole has joined #ocaml
zpe has joined #ocaml
zpe has quit [Ping timeout: 255 seconds]
NoNNaN has quit [Remote host closed the connection]
_twx_ has quit [Quit: No Ping reply in 180 seconds.]
_twx_ has joined #ocaml
tane has joined #ocaml
jerith has joined #ocaml
keen__ has joined #ocaml
pminten has joined #ocaml
keen_ has quit [Read error: Connection reset by peer]
angerman has joined #ocaml
zpe has joined #ocaml
Submarine has joined #ocaml
zpe has quit [Ping timeout: 240 seconds]
penglingbo has joined #ocaml
hhugo has joined #ocaml
angerman has quit [Remote host closed the connection]
angerman has joined #ocaml
rand000 has joined #ocaml
ygrek has joined #ocaml
thomasga has joined #ocaml
<whitequark> ooooh https://github.com/janestreet/comparelib → Quotation
<whitequark> I should make an extension node for that
<whitequark> though I'm not sure if (let module M = struct type t = ... end in M.t) is fast enough
<whitequark> Drup: how to call parameter for Enum?
<whitequark> type t = A [@value 1] | B [@value 10] [@@deriving Enum] ?
angerman_ has joined #ocaml
angerman_ has quit [Remote host closed the connection]
angerman has quit [Ping timeout: 245 seconds]
angerman has joined #ocaml
penglingbo has quit [Ping timeout: 245 seconds]
pminten has quit [Remote host closed the connection]
<ggole> I don't think a module with only types has any runtime cost.
morphles has quit [Ping timeout: 260 seconds]
<whitequark> ggole: oops, I mistyped
<whitequark> (let module M = struct type t = ... [@@deriving X] end in M.x)
<ggole> Ah.
<whitequark> no, it allocates a structure and then... something odd happens
<whitequark> it looks as if it has inlined the M.x call and (empty) module initializer, but did not DCE the structure allocation
<whitequark> this is silly
penglingbo has joined #ocaml
eikke__ has joined #ocaml
Thooms has joined #ocaml
thomasga has quit [Quit: Leaving.]
eikke__ has quit [Ping timeout: 256 seconds]
fold has quit [Ping timeout: 256 seconds]
thomasga has joined #ocaml
eikke__ has joined #ocaml
Anarchos has joined #ocaml
angerman has quit [Ping timeout: 245 seconds]
angerman has joined #ocaml
tobiasBora has joined #ocaml
<whitequark> hm, how would you typically find min/max elements of a list?
<whitequark> why is there no convenient function for that :<
<jerith> fold?
<whitequark> oh. I'm dumb
arjunguha has joined #ocaml
morphles has joined #ocaml
angerman has quit [Remote host closed the connection]
angerman has joined #ocaml
pminten has joined #ocaml
eikke__ has quit [Ping timeout: 240 seconds]
angerman has quit [Ping timeout: 245 seconds]
angerman has joined #ocaml
ygrek_ has joined #ocaml
ygrek has quit [Remote host closed the connection]
WraithM has quit [Ping timeout: 240 seconds]
tobiasBora has quit [Ping timeout: 272 seconds]
arjunguha has quit [Quit: My MacBook has gone to sleep. ZZZzzz…]
arjunguha has joined #ocaml
dsheets_ has joined #ocaml
arjunguha has quit [Client Quit]
Submarine has quit [Ping timeout: 255 seconds]
Submarine has joined #ocaml
tobiasBora has joined #ocaml
dsheets_ has quit [Ping timeout: 245 seconds]
dsheets_ has joined #ocaml
q66 has joined #ocaml
darkf has quit [Quit: Leaving]
angerman has quit [Remote host closed the connection]
angerman has joined #ocaml
dsheets_ has quit [Quit: Leaving]
pminten has quit [Remote host closed the connection]
angerman has quit [Ping timeout: 245 seconds]
angerman has joined #ocaml
tnguyen has joined #ocaml
dsheets has joined #ocaml
tnguyen has quit [Client Quit]
<companion_cube> whitequark: Sequence.of_list l |> Sequence.max ? :>
Thooms has quit [Quit: WeeChat 0.3.8]
dsheets has quit [Ping timeout: 240 seconds]
pango has joined #ocaml
pango_ has joined #ocaml
pango has quit [Client Quit]
pango_ has quit [Client Quit]
pango has joined #ocaml
dsheets has joined #ocaml
Ch0c0late has joined #ocaml
Ch0c0late has quit [Client Quit]
yacks has quit [Ping timeout: 260 seconds]
dsheets has quit [Quit: Leaving]
dsheets has joined #ocaml
lostman has quit [Killed (sinisalo.freenode.net (Nickname regained by services))]
angerman has quit [Remote host closed the connection]
angerman has joined #ocaml
zpe has joined #ocaml
angerman has quit [Ping timeout: 245 seconds]
pootler has joined #ocaml
zpe has quit [Ping timeout: 250 seconds]
angerman has joined #ocaml
yacks has joined #ocaml
Algebr has joined #ocaml
f[x] has joined #ocaml
ygrek_ has quit [Ping timeout: 260 seconds]
dsheets has quit [Ping timeout: 255 seconds]
dsheets has joined #ocaml
arjunguha has joined #ocaml
arjunguha has quit [Client Quit]
Thooms has joined #ocaml
yacks has quit [Ping timeout: 255 seconds]
yacks has joined #ocaml
leowzukw has joined #ocaml
Algebr has quit [Remote host closed the connection]
thomasga has quit [Quit: Leaving.]
leowzukw has quit [Quit: leaving]
subparity is now known as shallow
zpe has joined #ocaml
dsheets has quit [Ping timeout: 245 seconds]
dsheets has joined #ocaml
rand000 has quit [Ping timeout: 272 seconds]
zpe has quit [Ping timeout: 255 seconds]
<whitequark> how does ocamlbuild determine what goes into a .cma file?
<whitequark> oh, .mllib
caseyjames has joined #ocaml
<caseyjames> Hi, I can't seem to get findlib working. I get this error when starting OCaml - Cannot find file topfind. Unknown directive `require'.
<mrvn> Anyone familiar with ctypes? is there some magic to get defines ore enums from C headers?
<whitequark> mrvn: I don't think there is, however it is planned
<whitequark> caseyjames: how did you install OCaml?
<whitequark> what is your platform?
<caseyjames> homebrew for opam and ocaml and opam for the rest
<caseyjames> osx
<mrvn> how about something to turn a int (bitfield) into a list of flags?
morphles has quit [Ping timeout: 260 seconds]
<whitequark> caseyjames: do you do eval `opam config env` ?
<caseyjames> I did initially, yes. I just did again to no effect
<ggole> In the environment in which you are running ocaml?
<ggole> eg, *not* in a shell while you run ocaml from emacs
<whitequark> does echo $OCAML_TOPLEVEL_PATH display anything?
<whitequark> (ls $OCAML_TOPLEVEL_PATH should contain topfind)
thomasga has joined #ocaml
<caseyjames> yes, both of those are pointing to the right place - toplevel and topfind
<whitequark> ok, no idea then
<whitequark> there should be some analog of strace on osx
<ggole> (My concern still applies.)
<caseyjames> it has dtrace which is supposed to be similar
<whitequark> so I would do strace -eopen to see where it tries to look.
<caseyjames> like 'strace -eopen ocaml'
<whitequark> yes
dsheets has quit [Ping timeout: 255 seconds]
dsheets has joined #ocaml
izaak has joined #ocaml
rand000 has joined #ocaml
caseyjames has quit [Quit: Page closed]
Algebr has joined #ocaml
tane has quit [Quit: Verlassend]
<whitequark> um, why does ocamlbuild rule for .cmxs build it from .cmx and not .cmxa?
izaak has quit [Ping timeout: 272 seconds]
thomasga has quit [Quit: Leaving.]
<mrvn> How do I pass an ocaml string to a c function with ctypes?
<mrvn> let recv = foreign "zmq_recv" (ptr t_typ @-> string @-> int @-> flag_typ @-> returning int)
<mrvn> That doesn't seem to pass the right address
caseyjames has joined #ocaml
<caseyjames> Hi, I was able to output dtruss info on ocaml towards trying to get topfind working. It seems to mention it at line 180 https://gist.github.com/caseybasichis/ef73ea0096330beb69ae does this suggest the reason as to why ocamlfind isn't being seen?
<whitequark> tl;dr ocaml_string, but you need to ensure it is not captured
<whitequark> caseyjames: I recommend you kill homebrew'd ocaml and install ocaml via opam
<caseyjames> for sure, I'll try that now
<mrvn> whitequark: nice.
<mrvn> whitequark: I'm wondering though if I shouldn't use bigarrays in the first place. To make the buffer non-movable and such.
<whitequark> "it depends"
<whitequark> I think since messages are a lot, small and frequently passed to ocaml, you should use ocaml string
<mrvn> It will break at some point, when ctypes learns to release the global lock.
<caseyjames> How can i install ocaml from opam? I removed the homebrew version, but when I run opam I get - You current switch use the system compiler, but no OCaml compiler has been found in the current path. You should either: (i) reinstall OCaml version 4.01.0 on your system; or (ii) use a working compiler switch.
<whitequark> opam switch 4.01.0
zpe has joined #ocaml
Thooms has quit [Read error: No route to host]
<whitequark> mrvn: but you don't need that with zmq
<whitequark> use lwt-zmq
<whitequark> then it will never block
WraithM has joined #ocaml
Thooms has joined #ocaml
<mrvn> then I can't use multiple cores
<whitequark> use lwt-zmq *and* threads
<whitequark> although right now it is pointless, since threads aren't concurrent anyway
zpe has quit [Ping timeout: 240 seconds]
<mrvn> Error: Unbound value string_nocapture
<mrvn> Did I read this wrong or is my ctypes too old?
<whitequark> old ctypes?
<whitequark> you need 0.3.2
<mrvn> Installed: 0.2.3-1
<mrvn> :(
<whitequark> opam upgrade ctypes ?
<mrvn> debian
<whitequark> opam install ctypes, then
<whitequark> libzmq in debian is without CURVE anyway
<mrvn> I have newer packages for that :)
<whitequark> ooh great, 0.6.1 is on mentors.debian.net
<whitequark> sodium
angerman has quit [Remote host closed the connection]
angerman has joined #ocaml
ygrek_ has joined #ocaml
f[x] has quit [Ping timeout: 255 seconds]
<Algebr> So is Stream a module that is provided by camlp4?
<companion_cube> Algebr: no, but the syntax extension is
<whitequark> Stream should really be deprecated
<whitequark> together with Str
<Algebr> companion_cube: so [< >] is like a macro that gets expanded, presumably it must be making a ref variable
<companion_cube> whitequark: +1
<companion_cube> Algebr: [< >] is a macro over patterns over streams
<companion_cube> I guess in practice it compiles into pattern-match + recursion
<Algebr> and parser is a macro as well?
Thooms has quit [Quit: WeeChat 0.3.8]
<companion_cube> I think so, yes
Thooms has joined #ocaml
WraithM has quit [Ping timeout: 260 seconds]
WraithM has joined #ocaml
Thooms has quit [Client Quit]
Thooms has joined #ocaml
WraithM has quit [Client Quit]
WraithM has joined #ocaml
angerman has quit [Ping timeout: 240 seconds]
Hannibal_Smith has joined #ocaml
angerman has joined #ocaml
morphles has joined #ocaml
WraithM has quit [Ping timeout: 255 seconds]
agarwal1975 has quit [Quit: agarwal1975]
thomasga has joined #ocaml
pminten has joined #ocaml
<jerith> Whee! I have something that could possible be an AMQP client in the future. :-D
<Algebr> I forgot, what does exn usually mean again? Exception?
<def`> Algebr: yes
AltGr has joined #ocaml
fold has joined #ocaml
agarwal1975 has joined #ocaml
zpe has joined #ocaml
dsheets has quit [Ping timeout: 240 seconds]
dsheets has joined #ocaml
agarwal1975 has quit [Ping timeout: 240 seconds]
zpe has quit [Ping timeout: 264 seconds]
<Algebr> I don't understand this camlp4 syntax, [< 'Foo; x = some_parser >]. What is the x = some_func doing? Is it saying if I don't match on the item after 'Foo, then I'll try another parser named some_parser and whatever that matches, I'll bind it to x?
<whitequark> are you sure you want to use camlp4? it's being deprecated
<whitequark> and that interface is pretty bad anyway
<Algebr> whitequark: I don't have a choice in this instance.
<whitequark> any interface that camlp4 contains or uses
<whitequark> I see
<whitequark> try to look what it desugars to
<whitequark> i.e. run it through the camlp4o invocation
rand000 has quit [Quit: leaving]
<Algebr> I despise these syntax extensions, the whole lot of them.
<ggole> ...don't use them? Or are you required to?
<Algebr> required to, at the moment.
<ggole> :(
zarul has quit [Ping timeout: 272 seconds]
slash^ has joined #ocaml
tobiasBora_ has joined #ocaml
angerman has quit [Remote host closed the connection]
angerman has joined #ocaml
tobiasBora has quit [Ping timeout: 264 seconds]
caseyjames_ has joined #ocaml
arjunguha has joined #ocaml
angerman has quit [Ping timeout: 250 seconds]
zarul has joined #ocaml
angerman has joined #ocaml
arjunguha has quit [Ping timeout: 240 seconds]
pminten has quit [Quit: Leaving]
studybot has quit [Write error: Broken pipe]
studybot has joined #ocaml
pgomes has joined #ocaml
pgomes has left #ocaml [#ocaml]
_0xAX has joined #ocaml
angerman has quit [Remote host closed the connection]
angerman has joined #ocaml
jao has joined #ocaml
jao has quit [Changing host]
jao has joined #ocaml
morphles has quit [Ping timeout: 245 seconds]
_JokerDoom has quit [Quit: Leaving]
Thooms has quit [Quit: WeeChat 0.3.8]
<Algebr> so apparently ocaml can't run parallel code?
<whitequark> ocaml doesn't have thread-level parallelism, no
ygrek_ has quit [Ping timeout: 260 seconds]
<Algebr> I don't understand why ocaml has optionals AND exceptions
<ggole> Cos they aren't the same thing
<caseyjames_> whitequark: thanks for the opam install advice - topfind is now working
<whitequark> why does sexplib have a function is_polymorphic_variant, returning [`Surely_not | `Definitely | `Maybe]?! ಠ_ಠ
<ggole> Presumably it looks at layout tags
<ggole> Which don't contain enough info to tell in the general case
<jerith> ... I just spent 15 minutes debugging "val is a keyword, you moron".
<whitequark> yes, that tends to happen when you're just starting
<jerith> Turns out I can't use it as a variable name.
<ggole> Yeah, that's annoying.
<ggole> I always want to use begin and end.
<whitequark> start and finish!
englishm has joined #ocaml
zpe has joined #ocaml
<ggole> And type and function when fiddling around with language stuff.
<jerith> I had a similar problem with "type" earlier, except that was rather easier to debug.
<jerith> type frame = { type : int }
<whitequark> ok, I give up, I cannot read sources of sexplib.syntax
<whitequark> I'll just reverse-engineer it
zpe has quit [Ping timeout: 245 seconds]
<whitequark> someone thought it appropriate to comment -> assert false (* impossible *), but not iinh :: ainhs,
slash^ has quit [Read error: Connection reset by peer]
<ggole> Well, you wouldn't want people mistaking it for a well-tested code path.
<whitequark> I now regret even opening that file.
caseyjames has quit [Quit: Page closed]
caseyjames_ has quit [Quit: Page closed]
tobiasBora_ has quit [Ping timeout: 264 seconds]
ygrek has joined #ocaml
dsheets has quit [Ping timeout: 245 seconds]
<mrvn> whitequark: Maybe you have a good idea how to map this to ocaml? I have a zmp_msg_t that contains data and want to make that accessible as bigarray. But when the bigarray gets freed I need to close the zmq_msg_t.
<whitequark> do you use ocaml-zmq?
<mrvn> no.
<whitequark> why?
<mrvn> because it lacks the zmq_msg_t support
<whitequark> why do you need zmq_msg_t support?
<mrvn> because it allows receiving messages without having to allocating the buffer first with a maximum size and it supports credentials from e.g. CURVE.
<whitequark> (please don't tell "because of zmq_msg_gets")
<whitequark> ok
<whitequark> the latter I would have fixed in ocaml-zmq by adding a second recv function which also returns opaque token, corresponding to zmq_msg_t
<whitequark> and then a function to interrogate it
<mrvn> whitequark: same problem
<whitequark> not really, the token would simply be a custom object with a finalizer
<whitequark> ah, well, yes, same problem
<mrvn> but querying the data from the token needs to create a bigarray and keep the token alive
<whitequark> just finalize the bigarray
<mrvn> Wasn't it a bad idea to have lots of Gc.finalize calls?
<whitequark> I never heard that
<whitequark> mrvn: wait.
<whitequark> ocaml-zmq doesn't allocate a buffer with a maximum size first.
<mrvn> whitequark: right, because it uses zmq_msg_t internally. But it copies the data to string. I don't want to copy it.
<whitequark> is copying a performance bottleneck to you?
<mrvn> potentially
<whitequark> ok
<Drup> whitequark: "value" for Enum seems good
<whitequark> a ctypes rewrite is not a bad idea anyway, those heaps of C code make me uneasy
<Drup> mrvn: aren't you optimizing slightly prematurely ? :D
<mrvn> whitequark: yeah. and I want to learn ctype.
<whitequark> anyway, with ctypes you only have an option of finalizer
_0xAX has quit [Remote host closed the connection]
<whitequark> well
<whitequark> in principle you could make a custom block by ctyping to the ocaml runtime
<mrvn> Drup: I would have to copy the messages metadata map for every message just in case the metadata is later queried. That certainyl will hurt.
<whitequark> people write websites with Ruby which serve millions
* whitequark shrugs
<Drup> In this kind of case, I put a comment "(* OPTIM : we are doing X, it may hurt because of Y, we could do Z *)"
<mrvn> whitequark: do you have an example of a custom block being used with ctypes? I figure I need to somehow proviode an abstract type and a view for it.
angerman has quit [Ping timeout: 245 seconds]
<Drup> and I do X until profiling tells me otherwise
<whitequark> mrvn: that would certainly be premature optimization
<whitequark> you don't even know if Gc.finalize will somehow hurt or not
angerman has joined #ocaml
<whitequark> wait, how are you going to avoid copying with a bigarray?
<whitequark> you don't know the message size when you're allocating the bigarray
<mrvn> whitequark: I build one in a C stub that points to the messages data.
<mrvn> whitequark: recv then returns the newly created bigarray
<whitequark> "I build one in a C stub that points to the messages data." I don't understand this
<whitequark> hm, let me check ZMQ API
<whitequark> before you receive the message, you cannot know its length
<whitequark> and after you receive it, you *have* to copy it
<whitequark> whether to ocaml string or bigarray
<whitequark> so what copy exactly are you avoiding?
<mrvn> whitequark: zmq_msg_data gives me a pointer to the data, zmq_msg_size the size. With that I call caml_ba_alloc_dims()
<whitequark> ooooh I see
<whitequark> TIL you can allocate bigarrays pointing to existing data
<whitequark> that does seem like a good idea, yes
<mrvn> The drawback is that this requires the zmq_msg_t to remain alive until the bigarray is dead.
<Drup> you can do that ? :o
<Drup> because, I have exactly the same scheme in lmdb
<mrvn> You can from C.
<Drup> lmdb gives me a pointer to some data and a size
<whitequark> mrvn: note you can trivially bind to caml_ba_alloc_dims
<whitequark> use foreign "caml_ba_whatever", it will just work
<mrvn> that would be the plan. No need to write actualy C code. :)
<whitequark> ok
<Drup> mrvn: link me the code when it's done, I'm interested
<whitequark> Drup: oh, you're writing lmdb bindings? cool
<whitequark> I was going to write them too, now I won't
<Drup> the low-level part is done
<Drup> I have an issue because I have no idea how to bind enums in C
<Drup> so you can't use cursors for now
<mrvn> Another question: I want an exception free interface so function returning pointers that can be null I return as "t option". But what do I do with e.g. send? Should that return an "error option" with None meaning it worked?
<ggole> Probably as int32s
<Drup> the high level part is half done, it lacks said cursors
<whitequark> Drup: oh, the standard is wacky there
<whitequark> mrvn: [`Ok | `Error]
<mrvn> Drup: That part is hard. Usualy you write a C stub that mapps between C enum values and ocaml variants.
<Drup> whitequark: I will gladly take opinions on the interface. I have *something* but it's not super nice
<Drup> mrvn: meh, I wanted to get away with no C :(
<mrvn> Drup: is the enum starting at 0 and has no holes?
<ggole> Enums are occasionally used for bitsets, for which variants aren't really right
<Drup> it's a real enum, not a bunch of defines
<mrvn> ggole: variant list
<Drup> the bitsets issues are solved already
<ggole> Gah, that's so wasteful
<ggole> (I know, it doesn't matter.)
<Drup> (a set of constants and a + operation)
<Drup> :O
<Drup> :magic:
<whitequark> Drup: oh, neat, 6.4.4.3.2 An identifier declared as an enumeration constant has type int.
<Drup> 6.4.4.3.2 ?!
<Drup> did you just quote the C language manual ?
<whitequark> yes
<mrvn> whitequark: huh? should be dependent on its value
<Drup> x)
<whitequark> mrvn: look at n1570
<mrvn> enum Foo { FOO = 0xFFFFFFFFFFFFFFFFllu }; has unsigned long (long) type
<Drup> whitequark: and I'm the crazy one ? :p
<whitequark> mrvn: oh, okay, the standard is worded REALLY weirdly
<whitequark> Drup: I was wrong
<Algebr> I don't understand the purpose of begin/end.
<whitequark> prepare your eyes
<Drup> Algebr: same as { } in C
<whitequark> 6.7.2.2.4 Each enumerated type shall be compatible with char, a signed integer type, or an
<whitequark> unsigned integer type. The choice of type is implementation-defined,128) but shall be
<mrvn> Algebr: other word for ( )
<whitequark> capable of representing the values of all the members of the enumeration. The
jao has quit [Ping timeout: 255 seconds]
<whitequark> enumerated type is incomplete until immediately after the } that terminates the list of
<whitequark> enumerator declarations, and complete thereafter.
hhugo has quit [Quit: Leaving.]
<whitequark> whoever thought that is a good idea should be made to write C code daily
<whitequark> lol what, it gets better
<Drup> whoever though C was a good idea should be made to write C code daily :D
<whitequark> 128) An implementation may delay the choice of which integer type until all enumeration constants have
<whitequark> been seen.
<mrvn> whitequark: what it comes down to is that it is the fastest integer type that can hold all values.
<whitequark> mrvn: what it comes down is basically rand()%8
<Algebr> if begin/end is just another thing for code blocks, then why is it not always needed?
<whitequark> from the point of view of a developer that is equally useful
<whitequark> Algebr: like you can omit {} in C
<mrvn> Algebr: because lots of things naturally start a block
<Drup> begin/end are used in case of ambiguity
<Drup> for exemple, a match inside a match
<Drup> of the then part of an if/then/else
<Algebr> so I could actually do let foo a = begin match a with ...
<Drup> yes
<mrvn> if foo then begin if bla then () end else ()
<mrvn> Algebr: just like () a begin/end can be inserted basically everywhere
englishm has quit [Remote host closed the connection]
<Algebr> ah, got it.
<Drup> (also, this work too : "3 * begin 2 + 1 end")
<Drup> sign that it's really just parenthesis :p
<mrvn> Drup: nope.
ivan\ has quit [Quit: ERC Version 5.3 (IRC client for Emacs)]
<mrvn> Drup: the type of begin ... end is the type of its last expression
<Drup> which ... is the same for a parenthesis.
<mrvn> "begin 2 + 1 end" has type int and value 3. So 3 * 3 is perfectly fine.
<Algebr> is ignore basically like using ;?
<asmanur> Drup: yeah, we even have begin end = ()
<mrvn> Algebr: ignore gets rid of the error that you are not ignoring a return value
<Drup> mrvn: this is what I said ...
<mrvn> # begin end;;
<mrvn> - : unit = ()
<mrvn> wow.
<mrvn> didn't know it could be empty too
<asmanur> yep :P
<Drup> that's slightly ugly
<ggole> mrvn: try type t = Foo of int * int;; Foo begin 1, 2 end
<ggole> They are literally parens.
<mrvn> I guess you could have 'if foo then begin (* lets do this later *) end else 23
fold has quit [Quit: WeeChat 0.4.3]
<Drup> mrvn: you are thinking too far
<Drup> it's just begin = ( and end = ) at the parsing level
<mrvn> ggole: I wonder if begin and ( are the same token.
<Drup> and "( )" is as much unit as "()"
englishm has joined #ocaml
<ggole> mrvn: that would be my guess, yeah
<mrvn> Drup: is it? isn't "()" a single token and "( )" and empty expression resulting in unit?
<ggole> ...wait, not quite. Foo ( 1, 2 end doesn't match.
<Drup> mrvn: no
<ggole> (Which would be *really* disgusting.)
<mrvn> ggole: so not the same on a token level.
<whitequark> try "type a = ( )";;
<mrvn> *phew*
<ggole> Kind of a strange arrangemen.t
<ggole> And type t = begin end doesn't work either.
<ggole> So... they are sometimes parens.
* ggole wonders how much of this is the result of oversight, and how much design.
<whitequark> someone suggested on twitter that selecting the enum size based on rand(3) is legal by the standard
<Anarchos> whitequark what means type a= () ?
<whitequark> Anarchos: () is just a constructor with a weird name
<Drup> Anarchos: the same as "type a = FOO"
<whitequark> true and false are too
<Drup> Foo* is more standard
<Anarchos> whitequark ok but it will be difficult to create such values !
<whitequark> so you can have `type screw'me'right = true | () | false;;'
<whitequark> and then
<whitequark> utop # true;;
<whitequark> - : screw'me'right = true
<ggole> Anarchos: not really, you can just name it
<Drup> whitequark: wait wait, better
<ggole> type t = ();; type t = () # ();; - : t = ()
angerman has quit [Remote host closed the connection]
<Drup> type bla = true of bool ;;
<Drup> true true ;;
<Drup> do it.
angerman has joined #ocaml
thomasga has quit [Quit: Leaving.]
<Anarchos> ggole no it works here to use f() on f : t -> int
<Drup> I offer a cookie to the first one with an explanation
<Drup> ( nicoo, don't say anything)
<ggole> Anarchos: that's just using the new constructor
<ggole> (I think.)
<Drup> ggole: yep
<Anarchos> # let s = ();; val s : a = ()
ivan\ has joined #ocaml
<ggole> Anarchos: ah, are you using 4.02?
<Anarchos> ggole no : OCaml version 4.03.0+dev0-2014-05-12
<Drup> ahah !
<ggole> 4.02 or later, really
<Drup> since you are using 4.03
zpe has joined #ocaml
<ggole> It's type-directed disambiguation, or whatever that's called.
<whitequark> oooh, cool
<Drup> ggole: you gain a cookie :O
<Anarchos> i have 4.03.0+dev1-2014-07-21 in the oven :)
<Anarchos> ggole oh type disambiguation as for strings and formats ?
<Drup> not really
<ggole> type t = Foo and u = Foo;; let f Foo = 0 and g Foo = 1 in f Foo, g Foo
zpe_ has joined #ocaml
zpe_ has quit [Remote host closed the connection]
<ggole> The same constructor name there is disambiguated between t and u based on the type.
<Drup> ggole: you need some type constraint here, it's not gonna work otherwise
<ggole> Wait no, I need to interleave them for it to make sense.
<Drup> (actually, it will work ... just with the same Foo all the time
<Drup> anyway
skchrko has quit [Ping timeout: 255 seconds]
<Drup> whitequark, mrvn : so, how do I do enums ? :3
<whitequark> Drup: with a C stub
tobiasBora_ has joined #ocaml
<Drup> sadness :(
hhugo has joined #ocaml
zpe has quit [Ping timeout: 260 seconds]
<Drup> It's like a mini lilis
<Drup> whitequark: do you think the support for integers as key in an lmdb database is actually useful ?
<whitequark> as opposed to?
<Drup> strings
<Drup> in the lmdb interface, the default is string and there is a flag to use integers
<whitequark> nah, just keep strings
<Drup> of
<Drup> ok*
<Drup> I implemented both using a small functors, but it makes the interface weird
angerman has quit [Ping timeout: 245 seconds]
<whitequark> Drup: >Ocaml
<whitequark> ಠ_ಠ
<Drup> what ?
<Drup> oh, you mean the capitalization ? :D
<ggole> Change to ocAML to rub it in
<Drup> whitequark: there you go :p
angerman has joined #ocaml
<mrvn> Drup: Hash.t would be nice I guess
* whitequark slaps Drup around a bit with a large trout
<whitequark> (for commit message)
<Drup> whitequark: I knew you would appreciate :3
<Drup> mrvn: yes, but that's trivial to implement once you accept a string
<Drup> oh, Hash.t
<Drup> hmm
<mrvn> Drup: would be more efficient in the C interface if the lib already provides that
<Drup> that's not a bad idea, actually
<whitequark> Hash.t ?
<whitequark> we have a Hash.t ?
<Drup> whitequark: well, it's an int
<Drup> (I think there is a Hash.t in core)
<mrvn> In stdlib it is int.
<mrvn> Drup: maybe have Hashtbl.HashedType.t as type for your functor?
hhugo has quit [Quit: Leaving.]
<Drup> my functor takes "something that you can put into an enum data/size"
<mrvn> although a more general key,value module seems nicer
<Drup> more powerful, yes, nicer, I don't know
<Drup> that's the question
<mrvn> you need a key and a value and funtions to convert them to/from binary.
<Drup> I'm not afraid by functor applications, but I know some people are.
<Drup> mrvn: look at the interface :)
<Drup> it's already what I have
<mrvn> then we agree :)
<Drup> (VALUE need read/write and KEY need only write)
<whitequark> Drup: do some default instantiations
<mrvn> # module M1 = struct type t = Foo end module M2 = struct type t = M1.t end let t = M2.Foo;;
<Drup> whitequark: yes, that's what I was thinking
<mrvn> Error: Unbound constructor M2.Foo
<mrvn> How do I get M2.Foo defined without including everything from M1 in M2?
<mrvn> Drup: what? you can't open a DB and get a list of all keys?
<Drup> mrvn: cursors not implemented yet
<Drup> because I need to bind an enum
<Drup> :D
<mrvn> Drup: plan for it and have a read for keys too
morphles has joined #ocaml
<Drup> and also I need to figure out a type safe interface
<Drup> because the cursors interface is very ... C.
<Drup> (numerous way to shoot yourself in the foot, in several directions at the same time)
<mrvn> I need to get food
<ggole> mrvn: use poly variants
<Drup> to get food ? :D
<mrvn> ggole: the reason the type is in M1 is so it's below a namespace
<ggole> The type can still be namespaced
<Drup> mrvn: the other solution is just repeating the type
<ggole> But not the constructors.
<Drup> module M2 = struct type t = M1.t = Foo end
<Algebr> I can desugar camlp4, and I'm doing with it camlp4o foo.ml. That dumps it to the screen, but then I'm doing camlp40 foo.ml > foo_desugar.ml and I get nonsense. Some kind of encoding issue?
<ggole> (Which might not be what you want, of course.)
<mrvn> Drup: bad idea. then they are different types
<Drup> mrvn: but you want them to be equals !
<mrvn> Drup: wait, you repeat it but also assign the old type? That makes them equal, right?
<Drup> yes
<Drup> (it's call a manifest)
<Drup> (ask whitequark, he knows everything about them *wink*)
<mrvn> Ugly to type but that would work.
<Drup> Algebr: I remember a bug report abotu that
<whitequark> mrvn: I'll make a ppx_import
<Algebr> Drup: was there a fix?
<whitequark> so you could say type t = Foo.bar = [%import]
<Drup> whitequark: how would that work ?
<Drup> Algebr: absolutly not
<mrvn> Drup: alternative: module M1 = struct module T = struct type t = Foo end include T end module M2 = struct include M1.T end;;
<whitequark> Drup: it'll locate the cmi in the module path and pull the definition out of there
<Drup> nice.
<whitequark> need patch to ocamlc
<whitequark> but it'll be in 4.02
<mrvn> module M2 : sig type t = M1.T.t = Foo end
<mrvn> Drup: ends up with the double assignment too
angerman has quit [Remote host closed the connection]
<Drup> mrvn: yes, you can include too
<Drup> Algebr: but you can use -o
<mrvn> Drup: I will see what looks nicer in the end
<Drup> which should behave correctly
angerman has joined #ocaml
<mrvn> anyway, FOOOD
<Drup> mrvn: I usually include
<Algebr> Drup: yep that does the trick.
pootler has quit [Ping timeout: 245 seconds]
fold has joined #ocaml
<Algebr> So This is a valid pattern match: Some (1 | 2) ->
<Drup> yep
tautologico has joined #ocaml
<Algebr> Is this: Some ('A'..'Z') type of stuff only valid in pattern matching?
<ggole> Yes
tautologico has quit [Quit: My MacBook has gone to sleep. ZZZzzz…]
<Kakadu> I have looked at Raect and maybe I will need to add its support into lablqt...
englishm has quit [Remote host closed the connection]
zpe has joined #ocaml
zpe has quit [Ping timeout: 250 seconds]
Algebr has quit [Ping timeout: 240 seconds]
ygrek has quit [Ping timeout: 245 seconds]
angerman has quit [Read error: Connection reset by peer]
angerman has joined #ocaml
Muzer has quit [Excess Flood]
penglingbo has quit [Ping timeout: 260 seconds]
Muzer has joined #ocaml
izaak has joined #ocaml
NoNNaN has joined #ocaml
jsvgoncalves has joined #ocaml
tautologico has joined #ocaml
<whitequark> lol, I am reading this part of CamlinternalOO
<whitequark> type meths = label Meths.t type labs = bool Labs.t
<tautologico> Kids, don't do OO
<mrvn> whitequark: Is this the right way to handle an abstract pointer? http://paste.debian.net/111876/
<Drup> you don't need Obj.magic ...
<Drup> just do type t = unit ptr and make it abstract in the .mli
Algebr has joined #ocaml
<mrvn> Drup: that would allow the module itself to pass any unit ptr as t.
<Anarchos> whitequark are you playing with ocaml<->C interfacing ?
<Algebr> if I said _tags, what would that mean? in the context of ocamlbuild
<mrvn> Algebr: it means tags
<Algebr> right..which is what
<Drup> such enlightenment, mrvn. :D
<whitequark> mrvn: include (struct type t = unit ptr end : sig type t end)
<whitequark> something like that
<mrvn> can be anything. usualy you have the dependencies and compile options in _tags
<whitequark> mrvn: but also, if it's a voidp, then you *can* pass any unit ptr
<whitequark> mrvn: also if you want to follow the naming convention, make that of_voidp and to_voidp.
<whitequark> Anarchos: I do sometimes
<mrvn> whitequark: zmq has all abstract types as void*.
<Drup> mrvn: personnally, I would do a module with only Foreign declarations and another module using it
<Drup> and since there are only declarations in the module, you don't risk to pass anything along ...
<whitequark> mrvn: just do type ctx;; then use ctx ptr
<Algebr> ocaml ecosystem is huge...
<Drup> what did you expect ? :D
<Algebr> its too big. Python/Haskell is easier to manage
<whitequark> huh?!
<whitequark> python is enormous
<Drup> and Haskell is even less organized than ocaml
<Algebr> python is simple. There's the interpreter and pip. That's all you need.
<Drup> (and ocaml is not very well organized ...)
BitPuffin has joined #ocaml
<Algebr> Haskell is simple too. There's ghc and cabal.
<whitequark> there's ocaml and opam
<whitequark> everything else is legacy
<Algebr> and ocamlbuild
<Algebr> and corebuild
<Algebr> and camlp4
<mrvn> whitequark: how do I use that in foreign?
<Algebr> and batteries
<whitequark> how many lens libraries does haskell have, again?
<Drup> Algebr: huh, I'm going to ask a simple question
<Anarchos> whitequark it reminds me when i interfaced ocaml with the multithreaded C++ API of BeOS :)
<Drup> What library should I use if I want dates in python ?
<Algebr> datetime
<Anarchos> Drup libgirl ?
<whitequark> mrvn: hrm
<mrvn> let make = foreign "zmq_ctx_new" (void @-> returning (ptr_opt ctx) Error: Unbound value ctx
<Drup> Algebr: well, I've seen at least 3 different answers last time I asked this.
<whitequark> make it abstractly equal to unit
<whitequark> with my snippet above
ggole has quit [Ping timeout: 250 seconds]
<Drup> Algebr: also, corebuild is just an artifact for Core, it shouldn't exist.
<Drup> (side point, but still)
<mrvn> whitequark: that doesn't provide a value ctx
<tautologico> isn't corebuild just a thin wrapper around ocamlbuild?
<Algebr> its just I'm having to learn so much that is tangential to me getting code up and running. Its somewhat annoying.
<Drup> Algebr: well, why are you looking at camlp4 if you just want to do stuff ? X_x
<whitequark> mrvn: the value, too
<whitequark> let ctx = unit
<Drup> I mean, it's like starting haskell by looking at TemplateHaskell
<whitequark> ^
<Algebr> Because code samples that a relevant to me utilize campl4
<Algebr> camlp4
<Drup> mind to elaborate ?
<tautologico> I think some community standards are still in flux in OCaml, and that's one thing the OCaml Platform will try to fix
<Algebr> otherwise I have to look up ocamlyacc
<Drup> what code smaples ?
<mrvn> Error: This expression has type unit but an expression was expected of type 'a Ctypes.typ = 'a Static.typ
axiles has quit [Remote host closed the connection]
<mrvn> whitequark: do you mean let ctx = void?
<whitequark> yes
<Drup> Algebr: heeeh
<Drup> don't do that
<Drup> you should have asked
<tautologico> many of the important uses of camlp4 will shift to ppx soon
<Drup> whitequark: please kill this tutorial already
<tautologico> this tutorial is OLD...
<whitequark> Drup: which?
<Drup> the one Algebr just linked
<Drup> kill it
<tautologico> the kaleidoscope tutorial in OCaml from the llvm site
<whitequark> oooh, LLVM one
<Algebr> ....
<whitequark> Algebr: yes, it is horrible
<whitequark> I myself started to learn OCaml from it
<whitequark> and nothing ever made sense
<Algebr> where is the rage face emoticon.
<whitequark> (╯°□°)╯︵ ┻━┻ ?
<whitequark> I have it bound to <Compose_key> <t> <f>.
<Drup> :D
<Algebr> so I should just go straight up ocamlyacc?
<whitequark> menhir.
<Drup> better : menhir
<whitequark> I have some examples for you, in fact
<Algebr> see, that's my annoyance!
<whitequark> Algebr: well, it is old code being replaced by newer, much better code
<Drup> you may look at jpdeplaix' small language too, I think the architecture is sound
<whitequark> you can't just... un-implement camlp4
<tautologico> ocamllex + menhir is easy if you have used lex/yacc or any of its variants
<whitequark> although that would be nice
<Algebr> There ocamlyacc, oh no, use foo, wait that's deprecated use bar. I mean the spec ihas only been out since 1996 right? That's when ocaml hit the scene
<mrvn> whitequark, Drup: Does that look better? http://paste.debian.net/111879/
<Drup> Algebr: did you told me you liked Haskell ?
<tautologico> you can use ocamlyacc, menhir is jusr better
<Algebr> I do like haskell
<Drup> because the haskell ecosystem is filled with deprecated stuff
<Algebr> (which admittedly has its own problems, cabal hell and what not)
<whitequark> mrvn: I guess
<Drup> I mean, you can find GHC documentations that are one years old and completly deprecated
<Drup> they break their API all the fucking time
<Drup> at least in ocaml, you can take a 6 years old piece of code and compile it
<Drup> it may not be a very pretty piece of code
<Drup> but it will work
<Algebr> okay, so what can I do? I need to write a lexer/parser for my language
<tautologico> also you don't learn just Haskell, you have to learn tons of GHC extensions because code in the wild use them, a lot of them
<Drup> Algebr: ocamlyacc is the parser generator integrated to the compiler
<Drup> menhir is a replacement, 90% compatible, but with various facilities to make stuff easier
<whitequark> use menhir, menhir is *way* better
zpe has joined #ocaml
<whitequark> Algebr: do you need unicode lexing?
<Algebr> no
<Algebr> just ascii
<whitequark> then keep ocamllex
<Algebr> okay, so I use ocamllex, then feed that to menhir?
<whitequark> yes
<Algebr> and menhir will spit out what? an AST?
Puffin has joined #ocaml
<whitequark> whatever your rules return
<whitequark> you'll need to define your AST yourself and construct it in parser actions
<whitequark> Drup: I won't kill that tutorial
<whitequark> but you're welcome to rewrite it to use something more... modern
BitPuffin has quit [Ping timeout: 240 seconds]
<Drup> at least put something in the header about deprecatness
<whitequark> ~sigh~
<whitequark> it's not that bad, sans camlp4 and Stream
<Drup> it's not that bad, without the terrible part
<whitequark> exactly
<Drup> ad I don't disagree :)
<whitequark> is there an OCaml Summer of Code ?
<whitequark> get some intern to rewrite it
<whitequark> I ain't have no time for that
<Algebr> whitequark: are you on llvm team?
<whitequark> I'm the ocaml bindings maintainer
<whitequark> there's no "llvm team" per se, but I do have commit bit
zpe has quit [Ping timeout: 255 seconds]
_whitelogger has quit [K-Lined]
_whitelogger has joined #ocaml
<Drup> Algebr: may interest you : https://github.com/rizo/awesome-ocaml
<Drup> it contains only "up to date" libraries
whitequark has joined #ocaml
<whitequark> um
<whitequark> freenode just accidentally klined me
<whitequark> did I miss anything?
<Algebr> Drup: thank you! that's an awesome page
<Algebr> what is k lining anyway?
<whitequark> "kill line", basically permanent ip ban
<Anarchos> whitequark wow seems rather definitive ...
<Drup> Algebr: the ocaml.org tutorial page is also quite rich
angerman has quit [Read error: Connection reset by peer]
angerman has joined #ocaml
oriba has joined #ocaml
angerman has quit [Ping timeout: 245 seconds]
<morphles> How do I get ocamlopt from batteries included using opam? Or can I only get ocamlopt from batteries only by building it myself?
<Drup> ocamlopt from batteries ?
<morphles> I want ocamls native compiler with support of batteries included goodies (like list comprehensions)
<mrvn> morphles: just link against batteries, the compiler is the same
<Drup> just use the batteries library, there is no special version of ocamlopt for a specific library
<Drup> (also, list comprehensions are gone in batteries 2)
<morphles> wth
<morphles> so ocaml has no list comprehensions?
<Drup> no, you don't really need them
<morphles> I wonder, how do you come to that conclusion?
<Drup> because I have used languages with high order functions, language with comprehension, and even a language with both
<Drup> and the conclusion is that you don't need list comprehension if you have map filter and flatten.
<Algebr> +1
<morphles> Well we have asm, so fuck all other languages, since we can write anything using it anyways?
<Drup> you didn't get my point
<morphles> Yeah comprehensions are nothing fundamental but it is incredibly nice syntactic sugar
<Drup> except that the sugar is sometimes longer than the same with a map
<morphles> Well then you can use map
<mrvn> [expression for e in entries] == List.map (fun e -> expression) entries
<Drup> (and the sugar bolt lists in the language, which is not the best idea ever)
<Drup> Haskell's solution is ok, with monad comprehensions, but in the end, it's not used that much
<Drup> (because, as I said, it doesn't provide anything)
<Algebr> like Drup said, I've never used list comps. They shown in tutorials, but no body really uses them
Kakadu has quit [Quit: Konversation terminated!]
<Drup> It's used a lot in python basically because functionnal programming in python sucks :D
<morphles> Well ocamls has some way to go too :(
<Algebr> ...
<Drup> morphles: If you *really* want them
<morphles> Coming from haskell (even though I have not used it much), things like special words for recursive functions, then stack blowup on recursion unless some special measures are taken (afaiu, haven really gotten to them)
<Drup> I think there is a camlp4 syntax extension for that
<morphles> Well I will probably live without them
<morphles> As you guys say
<Drup> morphles: haskell will blow the stack equally, you know
<Drup> not in the same way, because :lazyness:
<morphles> I do not think that it is the case
<morphles> I think it trampolines all crap or something like that
<tautologico> you can blow the stack in Haskell
<Drup> morphles: just do an eager iteration on something too large
<tautologico> you can also have space leaks in Haskell because of laziness (so much fun!)
<morphles> Well never used anything eager on haskell
<Drup> lucky you
<morphles> An yeah lazyness i the part that got me looking into ocaml
<Algebr> seq "f" [1..]
<tautologico> serious Haskell code declares lots of things as eager
<tautologico> because the performance of all-lazy code is terrible
<morphles> and ofc haskells huge runtime does not help
izaak has quit [Remote host closed the connection]
<morphles> Well I do not think it's terrible its just hard to predict
<tautologico> it's terrble AND hard to predict :)
<morphles> Minuscule changes can have huge effects
<tautologico> you can look at the code of any library that cares about performance, even minimally, and you'll see lots of strictness
<morphles> ocamls hello world is like 5 times smaller than haskells, so thats a pluss in my book :)
<Drup> ocaml is more predictable. The price is that the compiler emits less sparkles :]
<Algebr> you mean main = print "hello word"?
<morphles> Yeah something like that
<tautologico> tradeoffs
<morphles> Does ocaml do tail call elimination by default?
<Drup> of course
<morphles> well thats good then :)
<tautologico> OCaml does have some annoyances and I think Haskell's syntax is more beautiful, but it's not like OCaml doesn't have its advantages
<Drup> (it would be completely unusable otherwise ...)
<morphles> I would think that its quite important for functional lang to have tail calls
<morphles> tautologico: pleas alaborate on ocamsl advantages:)
<Drup> tautologico: the big minus point I have with Haskell's syntax is that whitespace are significant
<Drup> I *hate* it.
<morphles> Drup: well python supposedly supports functionall pretty good, but it does not have tail calls nor does it ever plan
<whitequark> ruby has optional tail calls but it is not an advantage for ruby cod
<tautologico> we have been discussing some of them... strict by default, small and lean runtime, good module system, ...
<whitequark> code*
<morphles> god even tcl got tailcails recently (very nice lang btw), and I think ocaml has tk bindings, which is very nice
<morphles> Well I'll need to invest more till I see what this module system is about :)
<tautologico> the OCaml community tends to be more pragmatic, while the Haskell community tends to like more abstraction
<Drup> <insert lens library here/>
<morphles> Well I like abstactions :) But I'm also into minimalism, and one meg hello wold turns me down quite a bit
<tautologico> OCaml used to be a lot more stable (in the sense of changing less over time), but recently there have been lots of changes to the language, which is good in a way
<morphles> though one thing I miss quite a bit is typeclasses, and things like + and +. seem annoying after encoutering type classes
<tautologico> morphles: have you looked at the lenses libraries in Haskell? that's what I'm talking about
<morphles> nope
<whitequark> typeclasses, yeah
<morphles> As I said I have used haskell quite minimally
<morphles> some unfinished personal projects, and some project euler problems
<morphles> though read quite a bit on it
<tautologico> morphles: try to read up on them any time... it's extremely abstract, and most of the Haskell community seems to love it... profunctors and comonads and so on and so forth
tobiasBora_ has quit [Ping timeout: 245 seconds]
<tautologico> it's great if you like lots of category theory everywhere :)
jonludlam has joined #ocaml
Algebr has quit [Remote host closed the connection]
tobiasBora_ has joined #ocaml
jludlam has joined #ocaml
jonludlam has quit [Ping timeout: 260 seconds]
Muzer has quit [Excess Flood]
<dmbaturin> That's one of the reasons I never got to learning haskell: their use of overly complicated terminology. :)
tobiasBora_ has quit [Quit: Konversation terminated!]
zpe has joined #ocaml
jludlam has quit [Remote host closed the connection]
tautologico has quit [Quit: My MacBook has gone to sleep. ZZZzzz…]
tautologico has joined #ocaml
Submarine has quit [Remote host closed the connection]
zpe has quit [Ping timeout: 256 seconds]
tautologico has quit [Client Quit]
Muzer has joined #ocaml
Hannibal_Smith has quit [Quit: Sto andando via]
<mrvn> whitequark: How do I allocate an abstract type?
<Drup> allocate_n ~count:1 my_type
<Drup> you need the ctypes "type value"
<Drup> (that's if you want it not initialized, otherwise, "allocate"
<mrvn> Drup: It's absract so I can't initialize by value.
<mrvn> ok, now I have to figure out the right types
<mrvn> val close : msg Ctypes.abstract Ctypes.ptr -> int
<mrvn> is not included in
<mrvn> val close : t -> int
<Drup> show the code ?
<mrvn> already got it
tautologico has joined #ocaml
morphles has quit [Ping timeout: 240 seconds]
mcclurmc has quit [Remote host closed the connection]
manizzle has quit [Ping timeout: 255 seconds]
<mrvn> allocate_N is nice with its ~finalise argument.
<mrvn> I wish bigarrays had that
pango has quit [Ping timeout: 260 seconds]
pango has joined #ocaml
fold has quit [Quit: WeeChat 0.4.3]
tautologico has quit [Quit: My MacBook has gone to sleep. ZZZzzz…]
WraithM has joined #ocaml
cesar has joined #ocaml
cesar is now known as Guest58938
zpe has joined #ocaml
zpe has quit [Ping timeout: 245 seconds]
Puffin has quit [Ping timeout: 255 seconds]
BitPuffin has joined #ocaml
AltGr has left #ocaml [#ocaml]
jsvgoncalves has quit [Remote host closed the connection]
<Drup> I was going to do a PR to add a .merlin on the root of ocp-index
<Drup> x)
<Drup> (how ironic it would be)
darkf has joined #ocaml
Simn has quit [Quit: Leaving]
BitPuffin has quit [Ping timeout: 264 seconds]
BitPuffin has joined #ocaml
Anarchos has quit [Quit: Vision[0.9.7-H-20140108]: i've been blurred!]
WraithM has quit [Ping timeout: 264 seconds]
<ruzu> is wodi equivalent to opam?
thorsten` has quit [Ping timeout: 240 seconds]
zpe has joined #ocaml
thorsten` has joined #ocaml
zpe has quit [Ping timeout: 272 seconds]
madroach has quit [Ping timeout: 250 seconds]
madroach has joined #ocaml
NoNNaN has quit [Remote host closed the connection]
NoNNaN has joined #ocaml
hhugo has joined #ocaml
manizzle has joined #ocaml