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
travisbrady has quit [Quit: travisbrady]
eikke__ has joined #ocaml
travisbrady has joined #ocaml
BitPuffin has quit [Ping timeout: 264 seconds]
zpe has joined #ocaml
eikke__ has quit [Ping timeout: 264 seconds]
travisbrady has quit [Quit: travisbrady]
zpe has quit [Ping timeout: 256 seconds]
tobiasBora has quit [Quit: Konversation terminated!]
tristero has joined #ocaml
jwatzman|work has quit [Quit: jwatzman|work]
johnnydiabetic has joined #ocaml
johnnydiabetic has quit [Client Quit]
Algebr has joined #ocaml
<Algebr> I guess there isn't a trd function like fst/snd
demonimin_ has quit [Ping timeout: 256 seconds]
philtor_ has quit [Ping timeout: 255 seconds]
jao has joined #ocaml
jao has quit [Changing host]
jao has joined #ocaml
travisbrady has joined #ocaml
oriba has quit [Quit: oriba]
<def`> Algebr: then you would need fst3, snd3 together with thd3
huza has joined #ocaml
<Algebr> what is a .cmx?
troutwine is now known as troutwine_away
travisbrady has quit [Quit: travisbrady]
huza has quit [Remote host closed the connection]
q66 has quit [Quit: Leaving]
manizzle has quit [Ping timeout: 255 seconds]
rgrinberg has quit [Ping timeout: 255 seconds]
rgrinberg has joined #ocaml
shinnya has quit [Ping timeout: 255 seconds]
hellome has quit [Ping timeout: 250 seconds]
rgrinberg1 has joined #ocaml
rgrinberg has quit [Ping timeout: 240 seconds]
philtor_ has joined #ocaml
jao has quit [Ping timeout: 244 seconds]
lordkryss has quit [Quit: Connection closed for inactivity]
malo has quit [Remote host closed the connection]
huza has joined #ocaml
ygrek has joined #ocaml
huza has quit [Remote host closed the connection]
badon has quit [Ping timeout: 264 seconds]
huza has joined #ocaml
huza has quit [Remote host closed the connection]
ygrek has quit [Ping timeout: 245 seconds]
agarwal1975 has quit [Quit: agarwal1975]
maattdd has joined #ocaml
travisbrady has joined #ocaml
maattdd has quit [Ping timeout: 245 seconds]
huza has joined #ocaml
huza has quit [Remote host closed the connection]
so has quit [Remote host closed the connection]
travisbrady has quit [Quit: travisbrady]
so has joined #ocaml
Denommus has quit [Read error: No route to host]
so has quit [Remote host closed the connection]
so has joined #ocaml
ygrek has joined #ocaml
so has quit [Client Quit]
so has joined #ocaml
samrat has joined #ocaml
divyanshu has joined #ocaml
jjwatt` has joined #ocaml
<dmbaturin> If I define a type that includes a list (e.g. "type foo = Foo of int list | Bar of int list list"), how do I use the list in pattern matching?
philtor_ has quit [Ping timeout: 260 seconds]
jjwatt has quit [Ping timeout: 255 seconds]
<dmbaturin> "| Foo hd :: tl ->" causes "This pattern matches values of type 'a list but a pattern was expected which matches values of type foo" error.
rgrinberg1 has quit [Quit: Leaving.]
travisbrady has joined #ocaml
rgrinberg has joined #ocaml
Denommus has joined #ocaml
travisbrady has quit [Quit: travisbrady]
samrat has quit [Quit: Computer has gone to sleep.]
demonimin has joined #ocaml
jao has joined #ocaml
jao has quit [Changing host]
jao has joined #ocaml
<Algebr> Writing a .mly and getting this strange error, Error: The variant type list has no constructor While, where While is one of my data types.
hausdorff has joined #ocaml
jao has quit [Ping timeout: 240 seconds]
samrat has joined #ocaml
Algebr has quit [Ping timeout: 244 seconds]
<flux> dmbaturin, | Foo (hd::tl) -> ..
<flux> yours would work for, say, match [Foo []; Foo []] with | Foo hd :: tl -> ..
koderok has joined #ocaml
ggole has joined #ocaml
hausdorff has quit [Remote host closed the connection]
hausdorff has joined #ocaml
<dmbaturin> flux: Thanks!
hausdorff has quit [Ping timeout: 245 seconds]
axiles has joined #ocaml
samrat has quit [Quit: Computer has gone to sleep.]
michael_lee has joined #ocaml
ggole has quit [Read error: Connection reset by peer]
ggole has joined #ocaml
ggole has quit [Read error: Connection reset by peer]
ggole has joined #ocaml
<dmbaturin> Hhm, I wonder why my "pick_element l = List.nth (Random.int (List.length l))" always picks the first element when I use it inside a function.
<dmbaturin> If I use it on its own it looks fine, if I replace the random with a constant and use it inside that function it picks that element.
ggole has quit [Ping timeout: 255 seconds]
<flux> works for me(TM) (let pick_element l = List.nth l (Random.int (List.length l)) that is)
<flux> seems likely that function is not your problem.
<flux> I suppose you're not reinitializing the random seed?
<dmbaturin> I initialize it before calling the outer function.
<flux> typically you're supposed to call 'init' or 'self_init' at most once in the program
<flux> how about removing the initializing altogether and see how it works?
divyansr__ has joined #ocaml
divyanshu has quit [Quit: Textual IRC Client: www.textualapp.com]
divyansr__ is now known as divyanshu
divyanshu has left #ocaml [#ocaml]
<dmbaturin> flux: Tried, same problem. http://bpaste.net/show/hieIdjuspjcor1mI2wYB/ This is the function in question.
<flux> dmbaturin, well, I don't see a reason why it wouldn't work. make a debug-producing version of pick_element?
<flux> perhaps your lists are short and you have a back streak with random numbers.
ggole has joined #ocaml
<dmbaturin> Well, the lists are really short.
skchrko has joined #ocaml
<dmbaturin> But it seems to work fine when I use it on lists of just a few elements in the top level loop.
<flux> well, I just did Random.int 3 on the toplevel and got a sequence of five consecutive 2s
<flux> ..though not easily after doing Random.self_init ()
<dmbaturin> Interesting. "Random_self_init ();;" improves it a lot compared to "Random.self_init;;". I thought if the argument type is unit, I don't need to specify any argument.
<flux> 'Random.self_init' just refers to the value
typedlambda has quit [Ping timeout: 250 seconds]
<flux> you need to apply the argument to evaluate it
<flux> (and get the 'unit' value)
<flux> all ocaml functions have arguments, otherwise they are constants (let's not talk about methods..)
<flux> and () is no different from other arguments, except well, there is only one of them :)
<dmbaturin> Good to know. Now I understand why the compiler didn't say anything when I used "Random.self_init;;".
typedlambda has joined #ocaml
<flux> actually I would hope it would say something, because it's -almost- useless to do that
<flux> referring to a symbol in a module has the value of making sure that module is linked in
<dmbaturin> Are there any valid use cases for it?
<flux> in the case of module archives
samrat has joined #ocaml
<flux> and if that module is linked in, the module's initialization functions etc (if any) are evalutes
<flux> they may be side-effectful
<dmbaturin> As of the function itself, any style problems in it? Should I move reduce_sym out of it?
<flux> I like to keep internal helper functions internal, if they have no other use
<flux> so I approve :)
SethTisue has quit [Quit: SethTisue]
<dmbaturin> Ok, now I can start writing a function that checks if the grammar is fully defined.
<dmbaturin> And then I need to find out how to use the parser generator (whatever it was called).
<flux> good luck on your ventures ;-)
<dmbaturin> Well, I enjoy it so far. At least I haven't seen any behaviour that has no logical explanation or too many special cases, unlike in some other languages. :)
<flux> yes :). what are you writing?
<dmbaturin> flux: A program that generates random sentences that match a context-free grammar.
<dmbaturin> Where the grammar BNF is read from a file/user input.
<flux> that could be useful for generating test input.
<flux> or are you just writing it for fun?-)
<dmbaturin> I'm using parser testing as justification for having fun with it. :)
<flux> btw, you may want to look at 'menhir' instead of the standard ocaml parser generator
tac_ has quit [Quit: Leaving]
<dmbaturin> Yeah, I googled it lately but forgot the name.
<flux> not to be confused with merlin (which I did) which is a nice companion for emacs (and vim?) for ocaml
<whitequark> and vim and sublime-text
<dmbaturin> I still need to try merlin in vim.
ygrek has quit [Ping timeout: 240 seconds]
siddharthv_away is now known as siddharthv
Simn has joined #ocaml
sepp2k has joined #ocaml
kerneis_ is now known as kerneis
kvelicka1 has joined #ocaml
Nahra has quit [Remote host closed the connection]
eikke__ has joined #ocaml
eikke__ has quit [Ping timeout: 245 seconds]
ggole_ has joined #ocaml
manizzle has joined #ocaml
ggole has quit [Ping timeout: 245 seconds]
hhugo has joined #ocaml
lostman_ has joined #ocaml
piranha has joined #ocaml
<piranha> Hey all. I hope that's the right place to ask about emacs and utop, if not, please point me where to ask. I'm trying to get utop interactive shell running in Emacs, by using M-x utop (or pressing C-c C-s). My configuration is literally taken from RWO. It seems it tries to run but then reports 'display-buffer: Invalid buffer'. Any ideas what's wrong?
<whitequark> piranha: wild guess: is utop in path? this can be an issue if you use opam and don't start emacs from a shell
<piranha> whitequark: ah, forgot to say that, but yes, it's in path
<piranha> I checked with (shell-command "which utop") and looking in *Messages* buffer
kvelicka1 has quit [Quit: Leaving.]
<piranha> it reports proper path (/Users/piranha/.opam/system/bin/utop)
ygrek has joined #ocaml
<piranha> so I've turned on debug-on-error, and it tries to show *utop*, buffer, which does not exist :\
<piranha> heh, found it: http://paste.in.ua/9759/
<piranha> any ideas? I guess I required lwt without installing or something like that?
<piranha> heh, https://github.com/diml/utop/issues/1, but what's CAML_LD_LIBRARY_PATH?
AltGr has joined #ocaml
<piranha> ah, found it
<piranha> sorry for spamming :)
<gperetin> here's the fix for that https://github.com/diml/utop/issues/1
<gperetin> wow
<gperetin> sorry :D didn't have coffee yet
<piranha> haha, everything works :)
<piranha> coool
fraggle_laptop has joined #ocaml
Kakadu has joined #ocaml
sgnb has joined #ocaml
_0xAX has joined #ocaml
siddharthv is now known as siddharthv_away
siddharthv_away is now known as siddharthv
badon has joined #ocaml
eikke__ has joined #ocaml
koderok has quit [Quit: koderok]
rgrinberg has quit [Quit: Leaving.]
troydm has quit [Ping timeout: 250 seconds]
Reventlov is now known as Reventlov
<companion_cube> o/
troydm has joined #ocaml
Hannibal_Smith has joined #ocaml
thomasga has joined #ocaml
divyansh_ has joined #ocaml
pgomes has joined #ocaml
koderok has joined #ocaml
teiresias has quit [Quit: leaving]
jonludlam has joined #ocaml
jonludlam is now known as Guest46943
dsheets has joined #ocaml
pootler has quit [Quit: leaving]
pootler has joined #ocaml
ggole_ is now known as ggole
George__ has joined #ocaml
zpe has joined #ocaml
Muzer has quit [Quit: ZNC - http://znc.sourceforge.net]
Reventlov has quit [Quit: leaving]
Reventlov has joined #ocaml
locallycompact has joined #ocaml
kvelicka has joined #ocaml
BitPuffin has joined #ocaml
teiresias has joined #ocaml
<jerith> I find myself fighting the type system again. :-/
<jerith> I want to expose two modules, Client and Channel.
<jerith> Each of these modules contains a type t.
<jerith> I want both types to be opaque in the module interface, but I need to be able to store a Client.t inside a Channel.t and return it.
<def`> Just exposes "val store_client : t -> Client.t -> unit"
<def`> "val get_client : t -> Client.t" ?
<jerith> I can put my type definitions in a third module and then both Client and Channel have access to them, but Channel doesn't know that Client.t is the same as Types.client_t.
lostman_ has quit [Quit: Connection closed for inactivity]
nojb has joined #ocaml
<jerith> Channel only knows about Client through its interface.
<companion_cube> then why would you need a third module?
<whitequark> you can have, in module Client, type t = client_t
<whitequark> you can have, in module Client, type t = Types.client_t
<jerith> Actually, maybe I'm looking at the problem from the wrong direction.
Algebr has joined #ocaml
kvelicka has quit [Quit: Leaving.]
<jerith> I want Channel to use the internals of Client, but only expose a subset of that to external users of my library.
<jerith> So Channel should see everything inside Client, not just the things exposed in the public interface.
<def`> whitequark is right, type t = Some.other_path is called a "manifest" type, and is a proof of equality between both types even is the implementation is kept abstract
<jerith> Oh, I forgot another important thing.
<jerith> Client contains the code that creates the objects Channel operates on.
<jerith> def`: That's fine, but Channel only sees Client through its interface which keeps Client.t abstract.
kvelicka has joined #ocaml
<def`> jerith: in this case, you need to put channel and client in the same file and constraint the signature in the mli
<jerith> Hrm.
<jerith> I'd prefer to have them in separate files.
<jerith> Maybe client_impl.ml and channel_impl.ml with client.ml and channel.ml including those or something?
Muzer has joined #ocaml
<whitequark> no, just expose all the necessary operations in Channel
<whitequark> err, in Client
<jerith> Maybe I just need to expose channel_t in Client.
<jerith> I suppose Object.magic would give me what I want, but that it would be a really bad idea.
<whitequark> just use JavaScript then
<whitequark> ;)
elfring has joined #ocaml
<jerith> How would I put both things in the same file?
<whitequark> you can just have module Client = struct .. end module Channel = struct .. end
<whitequark> and make the type abstract in the signature
<def`> yes. otherwise, rethink your design, go for the _impl solution if you can't clean it up
tobiasBora has joined #ocaml
<jerith> Hrm. That would give me namespacing as well, I suppose.
<jerith> I'd have Ypotryll.Client and Ypotryll.Channel instead of just Client and Channel at the top level.
<def`> Yes
<def`> You can sill make Client and Channel module include Ypotryll._
<def`> (but it's usually a sign that coupling is too string, there might not be "two modules" there)
<jerith> The coupling is quite tight.
rand000 has joined #ocaml
<whitequark> just make it two types, or maybe two inner modules with type t, if you are so inclined
octachron has joined #ocaml
englishm_ has joined #ocaml
<jerith> There are distinct sets of connection-level and channel-level operations, though.
<whitequark> I would make two inner modules
tobiasBora has quit [Ping timeout: 255 seconds]
kvelicka has quit [Quit: Leaving.]
divyansh_ has quit [Quit: Computer has gone to sleep.]
divyansh_ has joined #ocaml
nojb has quit [Quit: ERC Version 5.3 (IRC client for Emacs)]
BitPuffin has quit [Ping timeout: 255 seconds]
divyansh_ has quit [Client Quit]
Algebr has quit [Ping timeout: 245 seconds]
divyansh_ has joined #ocaml
divyansh_ has quit [Client Quit]
agarwal1975 has joined #ocaml
<jerith> I have it working with a pair of internal *_impl modules and a wrapper module with Client and Channel submodules. \o/
<jerith> Thanks.
koderok has quit [Quit: koderok]
huza has joined #ocaml
samrat has quit [Quit: Computer has gone to sleep.]
koderok has joined #ocaml
huza has quit [Remote host closed the connection]
SethTisue has joined #ocaml
samrat has joined #ocaml
jjwatt` is now known as jjwatt
siddharthv is now known as siddharthv_away
englishm_ has quit [Remote host closed the connection]
SethTisue has quit [Quit: SethTisue]
englishm_ has joined #ocaml
huza has joined #ocaml
kvelicka has joined #ocaml
_andre has joined #ocaml
eikke__ has quit [Ping timeout: 264 seconds]
ygrek has quit [Ping timeout: 264 seconds]
ygrek has joined #ocaml
typedlambda has quit [Ping timeout: 250 seconds]
koderok has quit [Quit: koderok]
ygrek has quit [Ping timeout: 264 seconds]
typedlambda has joined #ocaml
eikke__ has joined #ocaml
darkf has quit [Quit: Leaving]
typedlambda has quit [Ping timeout: 250 seconds]
typedlambda has joined #ocaml
tobiasBora has joined #ocaml
englishm_ has quit [Ping timeout: 244 seconds]
NoNNaN has quit [Remote host closed the connection]
root2 has joined #ocaml
root2 has quit [Client Quit]
root2 has joined #ocaml
NoNNaN has joined #ocaml
huza has quit [Ping timeout: 240 seconds]
root2 is now known as huza
AltGr has quit [Ping timeout: 255 seconds]
AltGr has joined #ocaml
samrat has quit [Quit: Computer has gone to sleep.]
englishm has joined #ocaml
koderok has joined #ocaml
rand000 has quit [Quit: leaving]
BitPuffin has joined #ocaml
englishm_ has joined #ocaml
englishm has quit [Ping timeout: 240 seconds]
Algebr has joined #ocaml
BitPuffin has quit [*.net *.split]
kvelicka has quit [*.net *.split]
sgnb has quit [*.net *.split]
manizzle has quit [*.net *.split]
maufred has quit [*.net *.split]
Valdo has quit [*.net *.split]
_`_ has quit [*.net *.split]
robink has quit [*.net *.split]
alinab has quit [*.net *.split]
isomorphismes has quit [*.net *.split]
mrvn has quit [*.net *.split]
stevej has quit [*.net *.split]
scriptdevil has quit [*.net *.split]
gargawel_ has quit [*.net *.split]
ebzzry_ has quit [*.net *.split]
hnrgrgr_ has quit [*.net *.split]
BitPuffin has joined #ocaml
sgnb has joined #ocaml
manizzle has joined #ocaml
maufred has joined #ocaml
kvelicka has joined #ocaml
_`_ has joined #ocaml
Valdo has joined #ocaml
alinab has joined #ocaml
robink has joined #ocaml
mrvn has joined #ocaml
isomorphismes has joined #ocaml
stevej has joined #ocaml
scriptdevil has joined #ocaml
ebzzry_ has joined #ocaml
gargawel_ has joined #ocaml
hnrgrgr_ has joined #ocaml
bitbckt has quit [Ping timeout: 240 seconds]
englishm_ has quit [Ping timeout: 264 seconds]
bitbckt has joined #ocaml
bitbckt is now known as Guest30538
englishm has joined #ocaml
robink has quit [Max SendQ exceeded]
robink has joined #ocaml
lordkryss has joined #ocaml
jsvgoncalves has joined #ocaml
piranha has quit [Ping timeout: 250 seconds]
thomasga has quit [Quit: Leaving.]
shinnya has joined #ocaml
huza has quit [Quit: 哈哈]
<whitequark> grmbl
<whitequark> it seems that the patching technique used by ocamldebug is incompatible with dynamic code loading in toplevel
<whitequark> wohoo, more ad-hoc modifications to libcamlrun.
tane has joined #ocaml
thomasga has joined #ocaml
eikke__ has quit [Ping timeout: 260 seconds]
<Algebr> with menhir, what does it mean if menhir says "Warning: Symbol foo is never accepted"
Guest30538 has quit [Ping timeout: 240 seconds]
<whitequark> there is no input that would result in the rule for foo being executed
bitbckt_ has joined #ocaml
maattdd has joined #ocaml
englishm has quit [Ping timeout: 255 seconds]
Hannibal_Smith has quit [Quit: Sto andando via]
travisbrady has joined #ocaml
ygrek has joined #ocaml
<Algebr> whitequark: and if menhir says that something is in an epsilon cycle, that means that its an endless loop of sorts?
<whitequark> epsilon is no input
<whitequark> so, yes
samrat has joined #ocaml
englishm has joined #ocaml
_0xAX has quit [Remote host closed the connection]
jprakash has joined #ocaml
slash^ has joined #ocaml
thomasga has quit [Quit: Leaving.]
thomasga has joined #ocaml
yomimono has joined #ocaml
zz_flazz is now known as flazz
maattdd has quit [Ping timeout: 240 seconds]
koderok has quit [Quit: koderok]
Algebr has quit [Read error: Connection reset by peer]
travisbrady has quit [Quit: travisbrady]
travisbrady has joined #ocaml
Algebr has joined #ocaml
demonimin has quit [Ping timeout: 256 seconds]
gasche has quit [Ping timeout: 244 seconds]
<Algebr> I keep getting that my symbol is never accepted, but it seems correct to me....not even sure how to go about debugging this
<companion_cube> you can ask menhir to generate the automaton
<def`> can we see your grammar?
<Algebr> here is the AST
<Algebr> here is the parser http://lpaste.net/108836
<def`> which function is not accepted, where is the epsilon-cycle ?
<def`> production*
<companion_cube> the first rule is weird
<Algebr> the yagl_program, the main entry. A lot of it is commented out as I was trying to narrow down the issue
<companion_cube> I'm no expert, but it might be better with right-recursion instead of left-recursion
<octachron> Don't you need to separate the first rule from the main entry?
<Algebr> professor's code uses basically the same methodology and his works :(
<octachron> I think the epsilon-loop comes from this first rule
<def`> Algebr: add
<def`> main:
<def`> | yagl_program EOF { $1 }
<whitequark> ffuuuu, -g is incompatible with -custom
<def`> and use this as start point
<whitequark> well, it's *technically* compatible, but the compiler does not emit any debug info...
<def`> whitequark: ?! really?
<whitequark> yes
<def`> I never used this feature, but I don't see why it should behave differently at this stage with -custom
<def`> That's weird, should be fixed.
<whitequark> because of how the bytecode files are structured
<whitequark> and Obj.magic
<Algebr> def`: And what should the type of main be? a yagl_program?
<whitequark> well, no, actually, it's just because of laziness
<def`> Algebr: yes, exactly the same as yagl_program
philtor_ has joined #ocaml
<def`> whitequark: sounds likely :)
<Algebr> def`: Why did that work?
<def`> Algebr: the point is, menhir needs to know when the parse can be considered "finished". with the empty rule, it is correct to always considered consuming no token a successful parse
<def`> by adding EOF as terminator, it is not correct to use the empty rule unless there actually is EOF on input
tobiasBora has quit [Ping timeout: 245 seconds]
<Algebr> I don't understand then how my professor's code worked since he doesn't use EOF at all int he parser.
<def`> show us its original parser
englishm has quit [Ping timeout: 255 seconds]
<Algebr> fwiw, I'm using menhir and i think he used ocamlyacc.
<ggole> Looks like it will consume any valid decl or stop, ignoring trailing junk
englishm has joined #ocaml
<def`> hmm, maybe
<Algebr> I don't see that...
<ggole> Adding end of input is preferable IMO
<ggole> Algebr: testing on what input?
<whitequark> def`: ... no, it actually does put debug info there
<whitequark> why the fuck does it put SYMB, PRIM and CRCS twice?!
<ggole> Try something like <vdecl> <int>: I think it will parse and ignore the trailing int
shinnya has quit [Ping timeout: 245 seconds]
leowzukw has joined #ocaml
demonimin has joined #ocaml
demonimin has joined #ocaml
jprakash has quit [Ping timeout: 240 seconds]
travisbrady has quit [Quit: travisbrady]
koderok has joined #ocaml
travisbrady has joined #ocaml
sepp2k has quit [Quit: Konversation terminated!]
koderok_ has joined #ocaml
koderok has quit [Write error: Connection reset by peer]
koderok_ is now known as koderok
skchrko has quit [Quit: Leaving]
leowzukw has quit [Quit: leaving]
jprakash has joined #ocaml
travisbrady has quit [Quit: travisbrady]
pgomes has quit [Quit: http://www.kiwiirc.com/ - A hand crafted IRC client]
philtor_ has quit [Ping timeout: 250 seconds]
philtor_ has joined #ocaml
elfring has quit [Quit: Konversation terminated!]
pminten has joined #ocaml
maattdd has joined #ocaml
travisbrady has joined #ocaml
travisbrady has quit [Quit: travisbrady]
travisbrady has joined #ocaml
troutwine_away is now known as troutwine
travisbrady has quit [Client Quit]
travisbrady has joined #ocaml
rgrinberg has joined #ocaml
srcerer has quit [Quit: ChatZilla 0.9.90.1 [Firefox 30.0/20140605174243]]
srcerer has joined #ocaml
samrat has quit [Quit: Computer has gone to sleep.]
azynheira has joined #ocaml
ygrek has quit [Ping timeout: 255 seconds]
maattdd has quit [Ping timeout: 256 seconds]
samrat has joined #ocaml
julm has quit [Ping timeout: 256 seconds]
cthuluh has quit [Ping timeout: 272 seconds]
troutwine is now known as troutwine_away
jwatzman|work has joined #ocaml
cthuluh has joined #ocaml
julm has joined #ocaml
tac_ has joined #ocaml
ygrek has joined #ocaml
pminten has quit [Quit: KVIrc 4.2.0 Equilibrium http://www.kvirc.net/]
travisbrady has quit [Quit: travisbrady]
leowzukw has joined #ocaml
kvelicka has left #ocaml [#ocaml]
Kakadu has quit [Ping timeout: 246 seconds]
philtor_ has quit [Ping timeout: 250 seconds]
tane has quit [Quit: Verlassend]
jwatzman|work has quit [Quit: jwatzman|work]
philtor_ has joined #ocaml
Sim_n has joined #ocaml
_0xAX has joined #ocaml
Algebr has quit [Ping timeout: 255 seconds]
Simn has quit [Ping timeout: 240 seconds]
Sim_n is now known as Simn
philtor has joined #ocaml
q66 has joined #ocaml
samrat has quit [Quit: Computer has gone to sleep.]
Kakadu has joined #ocaml
philtor_ has quit [Ping timeout: 250 seconds]
troutwine_away is now known as troutwine
AltGr has left #ocaml [#ocaml]
yomimono has quit [Ping timeout: 256 seconds]
locallycompact has quit [Ping timeout: 245 seconds]
ollehar has joined #ocaml
Hannibal_Smith has joined #ocaml
slash^ has quit [Read error: Connection reset by peer]
tac_ has quit [Ping timeout: 240 seconds]
Anarchos1 has joined #ocaml
manizzle has quit [Ping timeout: 255 seconds]
bokxi has joined #ocaml
<bokxi> Hello, with ocamllex, I have a simple pattern for integer: ['0'-'9']+. However, an input sequence of 123sljfasd does not throw a scanner error. It just returns 123. Shouldn't it return an error since 123sljfasd is not an integer?
samrat has joined #ocaml
<Kakadu> It takes longest string it can match and returns it
<bokxi> Thanks kakadu. So how can I make it so that an input of 123sljfasd does return an error? Or is that not the scanner's job?
<def`> bokxi: the problem is definning the end of your string
<def`> an easy way would be to call the lexer again with an eof rule after the integer
orbitz has quit [Quit: restarting]
Algebr has joined #ocaml
Arsenik has joined #ocaml
<def`> int_of_string instead of string_of_int :P
bokxi has quit [Ping timeout: 246 seconds]
<ggole> I think he wants that 123foo be lexically malformed, which I think is reasonable
<ggole> (It's pretty strange that it is two lexemes in OCaml.)
<def`> (yep, that's surprising)
zpe has quit [Remote host closed the connection]
zpe has joined #ocaml
ygrek has quit [Ping timeout: 264 seconds]
zpe_ has joined #ocaml
zpe has quit [Read error: Connection reset by peer]
ollehar has quit [Ping timeout: 264 seconds]
jsvgoncalves has quit [Remote host closed the connection]
Algebr has quit [Remote host closed the connection]
zpe_ has quit [Remote host closed the connection]
zpe has joined #ocaml
zpe has quit [Read error: Connection reset by peer]
George__ has quit [Ping timeout: 246 seconds]
zpe has joined #ocaml
Thooms has joined #ocaml
zpe has quit [Remote host closed the connection]
zpe has joined #ocaml
_0xAX has quit [Remote host closed the connection]
dsheets has quit [Ping timeout: 244 seconds]
jwatzman|work has joined #ocaml
tac_ has joined #ocaml
zpe has quit [Ping timeout: 240 seconds]
philtor has quit [Ping timeout: 244 seconds]
BitPuffin has quit [Ping timeout: 255 seconds]
travisbrady has joined #ocaml
orbitz has joined #ocaml
michael_lee has quit [Quit: Ex-Chat]
ollehar has joined #ocaml
ollehar has quit [Client Quit]
Algebr has joined #ocaml
<rom1504> well no that's not surprising, there's no particular reason why you'd want to cut on the space
<Algebr> So Foo of string * string list means a something like Foo("hello", ["bar";"thing"]), and Foo of (string * string) list means Foo(["hello";"bar"]), right?
<rom1504> no
<companion_cube> Foo [("a", "b"); ("c", "d")]
<Algebr> k, thanks.
claudiuc has joined #ocaml
zpe has joined #ocaml
leowzukw_ has joined #ocaml
leowzukw has quit [Ping timeout: 260 seconds]
claudiuc_ has joined #ocaml
claudiuc_ has quit [Remote host closed the connection]
malo has joined #ocaml
claudiuc_ has joined #ocaml
claudiuc has quit [Read error: No route to host]
englishm has quit [Remote host closed the connection]
leowzukw_ has quit [Quit: leaving]
englishm has joined #ocaml
jprakash has quit [Ping timeout: 250 seconds]
jao has joined #ocaml
jao has quit [Changing host]
jao has joined #ocaml
olauzon has joined #ocaml
englishm has quit [Remote host closed the connection]
englishm_ has joined #ocaml
manizzle has joined #ocaml
yastero has left #ocaml [#ocaml]
Hannibal_Smith has quit [Quit: Sto andando via]
maattdd has joined #ocaml
dsheets has joined #ocaml
zpe has quit [Remote host closed the connection]
zpe has joined #ocaml
hhugo has quit [Quit: Leaving.]
zpe has quit [Ping timeout: 244 seconds]
hhugo has joined #ocaml
Arsenik has quit [Remote host closed the connection]
philtor_ has joined #ocaml
tobiasBora has joined #ocaml
samrat has quit [Quit: Computer has gone to sleep.]
hhugo has quit [Quit: Leaving.]
<Drup> tobiasBora: don't use Enum, use Sequence :>
<tobiasBora> Drup: For what problem ?
MercurialAlchemi has joined #ocaml
<MercurialAlchemi> Hi there
<MercurialAlchemi> What's the go-to build system for Ocaml?
<def`> ahah :D, Gnu make with OCamlMakefile
<companion_cube> Drup: :D
<Drup> MercurialAlchemi: ocamlbuild
<Drup> (just to bother def`)
<companion_cube> +1 for ocamlbuild, at least for starters
<jerith> I'm reasonably happy with OASIS, but I haven't really tried anything else.
<tobiasBora> Oasis
<jerith> (OASIS uses ocamlbuild.)
<companion_cube> oh, right, oasis
<MercurialAlchemi> I tried ocamlbuild + Makefile, but couldn't manage to convince it to produce shared lib + executable linking to the lib
<tobiasBora> Drup: I don't see how Sequences are better than Enum... They can't close the file right ?
<MercurialAlchemi> Oasis is a kind of Cabal?
<tobiasBora> MercurialAlchemi: I think yes
<tobiasBora> You just modify some lines in a config file and everything rools !
<tobiasBora> For basic stuff I love it
<tobiasBora> (but I never tried OcamlMakefile)
<Drup> tobiasBora: It's less messy
hhugo has joined #ocaml
<Drup> (and the feature you want is present, under the name Sequence.persistent
<MercurialAlchemi> I found findlib-wizard, but when I saw the huge Makefile it generated I ran away
<tobiasBora> Drup: Oh so you aren't in Batteries ? (BatSeq)
<Drup> *I*'m not in batteries
<Drup> :D
<Drup> but no, sequence is a separated package
<MercurialAlchemi> I'll try Oasis, then
<Drup> (named, surprise, "sequence" in opam :D)
<tobiasBora> Good idea...
<tobiasBora> Drup: Don't they have an online doc ? Because I always fall on Batteries ones.
<Drup> (they = companion_cube, btw)
philtor_ has quit [Ping timeout: 260 seconds]
<tobiasBora> You again ? :P Thank you !
<companion_cube> well try it before thanking :p
<tobiasBora> Is it in your great package ?
<MercurialAlchemi> sequence is some kind of iterator implementation?
<Drup> yes
ggole has quit []
<MercurialAlchemi> I was wondering how efficient naive map/filter/etc piping was in Ocaml
<companion_cube> MercurialAlchemi: it is, yes
<companion_cube> tobiasBora: there's CCSequence in containers, but there's also a standalone package on opam
<companion_cube> (the two share the same type)
<MercurialAlchemi> cool, I'm a big fan of iterators
<tobiasBora> And the same functions ?
<companion_cube> mostly, yes
<Drup> MercurialAlchemi: on lists, it's strict, so one iteration by functions
<tobiasBora> Nice !
<MercurialAlchemi> Drup: I feel the GC pressure already
<MercurialAlchemi> That's one of the thing the rust folk get right: most collection methods deal with iterators
<companion_cube> yes, that's very nice
<companion_cube> rust devs have made lots of very good design decisions, so far
<companion_cube> but they can learn from previous languages, so it's easier
<MercurialAlchemi> oh, sure
<MercurialAlchemi> at the same time, they did a good job of limiting the scope of the language
<MercurialAlchemi> it's going to be interesting once it's done
<MercurialAlchemi> On a completely different topic
<MercurialAlchemi> Any plans for checked exceptions?
<companion_cube> in rust? don't think so
<companion_cube> in ocaml, that would require an effect system
<MercurialAlchemi> In ocaml
<companion_cube> I don't think so
<MercurialAlchemi> Damn
oriba has joined #ocaml
<MercurialAlchemi> It's unfortunate for a language putting safety first
<companion_cube> imho exceptions are part of the "impure" side of OCaml (with side effects)
<companion_cube> the pure subset would use option/error types
<tobiasBora> Why are exception seen as impure ?
<companion_cube> because they don't show up in types, and because functions that use exceptions are not total
<MercurialAlchemi> In my limited Haskell experience, error types are a pain
<companion_cube> well, sometimes exceptions are useful :)
<companion_cube> but I found the error monad quite useful
<MercurialAlchemi> As soon as you want to abstract specific kind of errors (say SQLSyntaxError) into something less specific like DataError, while keeping the original for reference, you wish you were using exceptions
<def`> tobiasBora: exceptions have effect on the control-flow, you can't predict the result of an application
<def`> (and the are encoded as a monad in haskell :))
<MercurialAlchemi> and obviously, it's very useful to have exception hierarchies
tac_ has quit [Quit: Leaving]
<MercurialAlchemi> simulating this with error types is less than pleasant
<companion_cube> you could put the exceptions in the error type
<companion_cube> type ('a, 'b) or_error = `Ok of 'a | `Error of 'b
<tobiasBora> I see... But the option problem is that it's quite boring to deal with (you always need to do pattern matching... Or maybe I do it wrong ?)
<companion_cube> then, replace 'b with exn
<companion_cube> tobiasBora: monad
* companion_cube hints at CCOpt ^^
philtor_ has joined #ocaml
<MercurialAlchemi> hmm
koderok has quit [Quit: koderok]
<MercurialAlchemi> don't you lose the stack trace if you just create the exception without throwing it?
<companion_cube> oh, stacktraces
<companion_cube> hmm right
<companion_cube> maybe the distinction Exception/RuntimeException makes sense
zpe has joined #ocaml
<MercurialAlchemi> well, sure
<MercurialAlchemi> sometimes you need to escape from the box
<companion_cube> I mean, stuff like Failure shouldn't be caught anyway, and that's when you want stacktraces
<MercurialAlchemi> especially since in Java you can't parametrize by exception type the way you do with generics
<MercurialAlchemi> in Java you have (checked) Exception, (unchecked) RuntimeException and (unchecked)Error
locallycompact has joined #ocaml
<MercurialAlchemi> Error covers stuff like OutOfMemoryError, which can happen at any given time, but that you still want to catch when you need to close resources
<tobiasBora> companion_cube: Interesting...
<MercurialAlchemi> companion_cube: What's Failure?
_andre has quit [Quit: leaving]
Thooms has quit [Ping timeout: 240 seconds]
zpe has quit [Ping timeout: 245 seconds]
<companion_cube> MercurialAlchemi: the OCaml exception raised by "failwith"
<companion_cube> (in the standard library)
jao has quit [Remote host closed the connection]
<MercurialAlchemi> oh, yes
<MercurialAlchemi> well, sometimes you do want to catch everything
mcclurmc_ is now known as mcclurmc
Algebr has quit [Remote host closed the connection]
shinnya has joined #ocaml
philtor_ has quit [Ping timeout: 245 seconds]
BitPuffin has joined #ocaml
Ch0c0late has joined #ocaml
jao has joined #ocaml
jao has quit [Changing host]
jao has joined #ocaml
maattdd has quit [Quit: WeeChat 0.4.3]
axiles has quit [Remote host closed the connection]
flazz is now known as zz_flazz
<oriba> is there such a thing like (locally) opening a record, to easier access the fields?
<Drup> "let { bla ; blo ; blu } my_record"
<Drup> "let { bla ; blo ; blu } = my_record"
<oriba> ah, really? Is this new since 4.x ?
<Drup> no
<oriba> hmhh
<Drup> it's just let binding + pattern matching
<Drup> the shortcut may be recent, I'm not sure
<oriba> then it seems I not often used this syntax/feature... I thought I have to write { myrecord with x = foo; y = bla }
<Drup> that's not the same thing
<dsheets> used to be let { bla=bla; blo=blo; blu=blu } = my_record then we got "punning"
<oriba> what is "punning"?
<dsheets> this same pattern-match + bind-to-field-name
<oriba> hmhh
<Drup> It's the active fact of doing puns
<dsheets> the record field 'bla' and the value 'bla' sound the same
<Drup> ( :] )
<dsheets> so just say it once
<dsheets> that was 3.12 or 4? can't recall
<oriba> so, I guess this way of writing it is new?!
<oriba> ah, ok
<oriba> I had programmed with 3.11.something for very long time
<oriba> before then switching to 4.x
<gperetin> oriba there's a nice explanation of punning with examples here https://realworldocaml.org/v1/en/html/records.html
<gperetin> if you're interested
<oriba> yes, thx
<gperetin> (just search for field punning, or scroll a third of the page down)
<oriba> a lot more fetaures since 3.11.x ;-)
<oriba> *features
Thooms has joined #ocaml
hhugo has quit [Quit: Leaving.]
hhugo has joined #ocaml
Thooms has quit [Quit: WeeChat 0.3.8]
bernardo1pc has quit [Quit: leaving]
bernardofpc has joined #ocaml
bernardofpc has quit [Client Quit]
bernardofpc has joined #ocaml
thomasga has quit [Quit: Leaving.]
thomasga has joined #ocaml
zpe has joined #ocaml
zarul has joined #ocaml
jao has quit [Ping timeout: 240 seconds]
Anarchos1 is now known as Anarchos
zpe has quit [Ping timeout: 264 seconds]
hhugo has quit [Quit: Leaving.]
zz_flazz is now known as flazz
<tobiasBora> I have a problem I can't manage to debug...
<tobiasBora> I use a facultative argument like this:
<tobiasBora> let f1 ?(myarg=true) () = ...;;
<tobiasBora> And in order to keep using the same default arg everywhere I put then
<tobiasBora> let g1 ?myarg () = ... f1 ?myarg () ... ;;
<companion_cube> sounds good so far
<tobiasBora> Like this myarg is supposed to be a boolean
<tobiasBora> However I have an error
<tobiasBora> # Error: This expression has type bool option but an expression was expected of type bool
<tobiasBora> How my variable can suddently begin a "bool option" ?
<companion_cube> myarg in g1 is a bool option
<companion_cube> in f1 it's a bool
<tobiasBora> Really ?
<tobiasBora> hum...
ollehar has joined #ocaml
<tobiasBora> And why g1 is bool option ? Can't I have g a bool like f1 ?
<companion_cube> because since you didn't give a default, OCaml can't choose a value
<companion_cube> in case the argument is left implicit
<companion_cube> like: g1 () (* what's the value of myarg? *)
<companion_cube> but: f1 () (* myarg=true *)
philtor_ has joined #ocaml
<tobiasBora> Well I though that Ocaml see that f1 expect a bool with default value true, so like in typage g1 whould get the same default value...
azynheira has quit [Ping timeout: 240 seconds]
octachron has quit [Quit: Page closed]
<tobiasBora> And is there a pretty turn-around to that ?
<companion_cube> I tend to keep things like this, and not use myarg in g1
<companion_cube> note: you can do f1 ?myarg:None () ← will use default value
<companion_cube> optional arguments are like labelled arguments, but wrapped in options
<companion_cube> if the argument is None *and* a default value is specified, then this value is used
<tobiasBora> I understand... That's a bit strange but I see, thank you !
<companion_cube> that's very convenient
<companion_cube> let f1 ?(myarg=true) () = foo is actually let f1 ?myarg () = let myarg = match myarg with None -> true | Some x -> x in foo
<tobiasBora> Whouldn't be even more convenient if the default value where inherited, like type ?
<companion_cube> values are more complex than types
<tobiasBora> why ?
<companion_cube> sometimes you also *want* to have an option
<tobiasBora> Then you don't use it with a function which waits for a non-option !
<companion_cube> you mean, g1 shouldn't be able to call f1
<companion_cube> ?
<companion_cube> but what g1 gives to f1 is an option
<companion_cube> then f1 can use its default value if required
<tobiasBora> Well I would add an "operator", let's call it *,
ollehar has quit [Ping timeout: 250 seconds]
<tobiasBora> in let f1 *(myarg=def), myarg would be a NON-option
<companion_cube> myarg isn't an option in f1
<tobiasBora> and in let g1 *myarg, myarg is still a NON-option, whose default value is taked from f1
<companion_cube> but if f1 is defined in another module?
<tobiasBora> uhm
<companion_cube> I mean, that kind of breaks abstraction
<companion_cube> f1 should be able to choose what it wants as default value
Kakadu has quit [Quit: Konversation terminated!]
<tobiasBora> Well if f1 is in another module, g1 doesn't need to know what is the default value, he just need to know that one exists
tac-tics has joined #ocaml
<tobiasBora> Oh yes I see
<tobiasBora> There should be a way to know what is this value if you wan't to use it in g1
<tobiasBora> So a new "function" should be done to know it...
<tobiasBora> Of course it should be transparent for the user
<tobiasBora> So each time a function with a default value is created it should create a function to get it
<tobiasBora> and it's not trivial to do
<tobiasBora> (but still possible, maybe useless)
travisbrady has quit [Quit: travisbrady]
Ch0c0late has quit [Ping timeout: 256 seconds]
yomimono has joined #ocaml
olauzon has quit [Quit: olauzon]
Anarchos has quit [Quit: Vision[0.9.7-H-20140108]: i've been blurred!]
thomasga has quit [Quit: Leaving.]
<tobiasBora> That's much clearer now, thank you !
<companion_cube> you're welcome
philtor_ has quit [Ping timeout: 264 seconds]
englishm_ has quit [Remote host closed the connection]
thomasga has joined #ocaml
englishm has joined #ocaml
zpe has joined #ocaml
nojb has joined #ocaml
Simn has quit [Quit: Leaving]
zpe has quit [Ping timeout: 264 seconds]
yomimono has quit [Ping timeout: 245 seconds]
yomimono has joined #ocaml
tobiasBora has quit [Quit: Konversation terminated!]
englishm has quit [Remote host closed the connection]
englishm_ has joined #ocaml
englishm_ has quit [Remote host closed the connection]
englishm has joined #ocaml
englishm has quit [Remote host closed the connection]
englishm_ has joined #ocaml
yomimono has quit [Quit: Leaving]
englishm_ has quit [Read error: Connection reset by peer]
ebzzry__ has joined #ocaml
ebzzry_ has quit [Ping timeout: 255 seconds]
agarwal1975 has quit [Quit: agarwal1975]
flazz is now known as zz_flazz
philtor_ has joined #ocaml
<oriba> my sprintf does not 0-padding ?!
<oriba> # Printf.sprintf "%+02s\n" "2";;
<oriba> - : string = " 2\n"
<oriba> Printf.sprintf "%02s\n" "2";;
<oriba> - : string = " 2\n"
darkf has joined #ocaml
<oriba> should be "02\n"
MercurialAlchemi has quit [Ping timeout: 245 seconds]
<oriba> ah, no... only with %d
<oriba> Printf.sprintf "%02d\n" 2;;
<oriba> - : string = "02\n"
sad0ur has quit [Ping timeout: 245 seconds]
zz_flazz is now known as flazz
zpe has joined #ocaml
philtor_ has quit [Ping timeout: 250 seconds]
zpe has quit [Ping timeout: 256 seconds]
agarwal1975 has joined #ocaml
agarwal1975 has quit [Ping timeout: 240 seconds]
locallycompact has quit [Ping timeout: 240 seconds]
Algebr has joined #ocaml
<Algebr> Does an underscore like so have any meaning? ('_a * string) list
madroach has quit [Ping timeout: 250 seconds]
madroach has joined #ocaml
<def`> Algebr: it's a "weak polymorphic variable" or "inference/unification variable"
<def`> it means the type for this value has not yet been completely infered because you have not yet used the first component of the items of th list
flazz is now known as zz_flazz
NoNNaN has quit [Remote host closed the connection]
NoNNaN has joined #ocaml
nojb has quit [Ping timeout: 255 seconds]
agarwal1975 has joined #ocaml
darroyo has joined #ocaml