gildor changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | OCaml 3.12.1 http://bit.ly/nNVIVH
dnolen has quit [Read error: No route to host]
dnolen_ is now known as dnolen
sepp2k1 has quit [Read error: Connection reset by peer]
vpalle has quit [Read error: Connection reset by peer]
sebz has quit [Quit: Computer has gone to sleep.]
sebz has joined #ocaml
struktured has joined #ocaml
EmmanuelOga has quit [Quit: WeeChat 0.3.7-dev]
<everyonemines> What's the best way to make a deep copy of a multi-dim array?
<everyonemines> array of array that is
<everyonemines> I guess Array.map Array.copy ?
<thelema> yes, a matrix is best deep-copied with Array.map Array.copy
everyonemines has quit [Quit: Leaving.]
<beginner> thelema there?
<thelema> beginner: yes
<beginner> I think I still don't quite understand with pattern matching
<thelema> ok
<beginner> when the pattern is variable name instead of let say a constant
<thelema> when the pattern is a constant, the value being matched is tested to see if the indicated part is equal to that constant
<beginner> yup
<thelema> when the pattern is a variable name, the value being matched is destructured and the appropriate part of the input "assigned" to that variable
<beginner> example?
<thelema> for example: let x = (1,2,(3,4)) in match x with (a,3,_) -> a | (1,b,(c,d)) -> b+c+d | (a,b,c) -> ...
<beginner> ok
<beginner> get this one
<thelema> in the first match case, a = 1
<thelema> in the last match case, c = (3,4)
<thelema> _ is actually just a special case of giving part of the pattern a name, except the name _ doesn't actually bind anything
<thelema> beginner: line 5 will match every input value and return it back.
<thelema> well, it would if there was a ->
<beginner> yeah, I thought I understand that part but I don't quite actually
<beginner> on why it matched everything
<thelema> because line 5 is equivalent to | x -> x
<beginner> but I thought we define `let zero = 0;;
<beginner> `
<beginner> *defined
<beginner> so it should work like `| 0 -> 0`
<thelema> yes, but that doesn't prevent you from redefining the identifier "zero"
<thelema> This is valid: let zero = 0;; let zero = 1;;
<thelema> in the second [let], the text "zero" isn't replaced by "0"
<thelema> in the same way, identifiers in match patterns are on the left hand side of the =
<beginner> ermm
<thelema> even though you can have literals as part of the pattern, and identifiers in a pattern are there only to be given new values
<thelema> s/and/any/
<beginner> I think after looking at this line `j -> fib (j - 2) + fib (j - 1);;`
<beginner> I think i get it especially after your explanation
<beginner> so whatever value on the left hand side of the ->
<beginner> will be used to replace the variable on the right hand side
<beginner> like j -> j + 1
<beginner> so 2 -> 2 + 1
<beginner> correct?
<thelema> the value being matched is bound to the identifier given as if there was a "let j = 2"
<thelema> the scope for this binding is just that one match case, of course
<beginner> alright
<beginner> now I get it
<thelema> "If a compiler cannot diagnose the syntax of an individual statement until it reaches the end of the program, what hope has a poor human?" - Hoare, 1973
<beginner> I think I am probably the dumbest noob you have ever taught ^_^
<thelema> beginner: I've taught people who had problems double-clicking - I have a *lot* of patience
<beginner> alright, I will go to sleep now and try to learn more when I wake up
<beginner> thank you so much thelema!!!
arubin has quit [Quit: arubin]
dnolen has quit [Quit: dnolen]
dnolen has joined #ocaml
struktured has quit [Remote host closed the connection]
arubin has joined #ocaml
alpounet has quit [Ping timeout: 248 seconds]
musically_ut has joined #ocaml
taupin has quit [Ping timeout: 258 seconds]
Pepe_ has quit [Ping timeout: 244 seconds]
joewilliams has quit [Ping timeout: 248 seconds]
superbobry has quit [Ping timeout: 258 seconds]
lopex has quit [Ping timeout: 248 seconds]
Pepe_ has joined #ocaml
alpounet has joined #ocaml
musically_ut has quit [Ping timeout: 255 seconds]
taupin has joined #ocaml
joewilliams has joined #ocaml
ulfdoz has joined #ocaml
struktured has joined #ocaml
yroeht has quit [Ping timeout: 252 seconds]
yroeht has joined #ocaml
lopex has joined #ocaml
roconnor has quit [Ping timeout: 252 seconds]
superbobry_ has joined #ocaml
superbobry_ is now known as bobry
ulfdoz has quit [Ping timeout: 240 seconds]
arubin has quit [Quit: arubin]
ftrvxmtrx_ has joined #ocaml
dnolen has quit [Quit: dnolen]
ftrvxmtrx has quit [Quit: This computer has gone to sleep]
edwin has joined #ocaml
ygrek has joined #ocaml
ygrek has quit [Remote host closed the connection]
raichoo has joined #ocaml
<adrien> 33k insertions in my project because I've added 6 setup.ml files from oasis :P
Cyanure has joined #ocaml
ygrek has joined #ocaml
ttamttam has joined #ocaml
Cyanure has quit [Remote host closed the connection]
ankit9 has joined #ocaml
ikaros has joined #ocaml
<adrien> am I the only one who is mostly happy with how the ocaml language evolves? what I think could be improved is the development of the compiler/stdlib but not so much the language/typing itself (it might have to do with the fact I can't do anything there)
Cyanure has joined #ocaml
<avsm> the happy people dont bother posting to the ocaml list to express their joy
<adrien> hot topic require some precautions
sebz has quit [Quit: Computer has gone to sleep.]
roha has joined #ocaml
TaXules has joined #ocaml
scrappy_doo_ has left #ocaml []
eikke has joined #ocaml
_andre has joined #ocaml
_andre has quit [Client Quit]
avsm has quit [Quit: Leaving.]
_andre has joined #ocaml
destrius has quit [Quit: Leaving.]
Drakken has joined #ocaml
roha has quit [Remote host closed the connection]
ankit9 has quit [Ping timeout: 240 seconds]
emmanuelux has quit [Remote host closed the connection]
ankit9 has joined #ocaml
ygrek has quit [Ping timeout: 248 seconds]
Modius has quit [Quit: "Object-oriented design" is an oxymoron]
ankit9 has quit [Ping timeout: 240 seconds]
ftrvxmtrx_ has quit [Quit: Leaving]
ftrvxmtrx has joined #ocaml
<maufred> Hello, would anyone know if it's possible to clean an out_channel (specificaly stdout) without flushing it ?
ikaros has quit [Ping timeout: 244 seconds]
<adrien> no idea; that sounds weird; what's the reason for wanting to do that?
<maufred> First, i'm printing a title, then I do a calculus that may raise an exception. If there is actually this exception, I want to clean that out channel to only print an error. and then I exit (which flushes all out_channel)
<adrien> I'd probably do it differently: 1- use stderr for the exception and stdout for the regular calculus output; or 2- wait before outputting the calculus at all; or 3- clear the console with ascii control codes
<adrien> I prefer 1 over 2 which I prefer over 3
<adrien> 1 is also easier to do than 2 which is itself easier to do than 3
<maufred> hm I see.
<maufred> But right now, If i get the error, I flush it already on the stderr
<maufred> but I don't get the right result on stdout (which is normal because the calculus failed)
<adrien> so you want to clear stdout to avoid the result being used anyway?
<maufred> yes
<maufred> I was wondering if I should use a seek_out
<adrien> you could also put everything in a Buffer.t and print from it if it succeeded
<adrien> you can't seek inside streams
<maufred> Ah, good to know !
<adrien> I don't know if "stream" is the right word but you can't seek on stderr/stdout/stdin afaik
<maufred> Ok that If i use Buffer, I just need to re-write my printing functions, but that may be the right thing to do
<adrien> (simply imagine the case of sending 100GB of data through a pipe: all the data won't be kept in-memory all the time)
<maufred> yes
<adrien> maufred: well, be sure to see Buffer.output_buffer and Buffer.add_channel
<maufred> I was trying to get so notes about this but didn't find something
<maufred> if you have any link, I would be grateful
ttamttam` has joined #ocaml
<adrien> Buffer.output_buffer is going to be very useful; Buffer.add_channel, not so much unless you really want to make as little changes as possible (but that's really pushing it)
<adrien> maufred: notes about what exactly?
ttamttam` has quit [Remote host closed the connection]
<maufred> In fact, I would like to know when a data is flushed. As you said, I will not keep 100GB data in a pipe, there must be something that says, if I don't flush it, then the 'GC' do it ?
<adrien> see the documentation for the C function setbuf
<maufred> OK, thank you very much
<adrien> I thought it was bound somewhere in the stdlib but I can't find it anymore
<maufred> If I may, just to be clear
<maufred> In my program, I'm using kprintf (which is depracated). If I switch to kbprintf, I should get the result I want ?
<adrien> sorry, I don't know: I've never used the kprintf family of function
<maufred> he he, OK
<maufred> anyway thanks for the quick help !
larhat has joined #ocaml
<adrien> no problem =)
rgrinberg has joined #ocaml
g0dmoney- has quit [Ping timeout: 258 seconds]
g0dmoney- has joined #ocaml
g0dmoney- has quit [Ping timeout: 252 seconds]
g0dmoney- has joined #ocaml
Kakadu has joined #ocaml
<flux> ooh, http://www.lexifi.com/blog/runtime-types - not sure what to think of this ;)
<adrien> "\o/" ?
<adrien> I'm curious about their GUI stuff
<flux> adrien, yes, \o/, sort of.. but.. dynamic typing for ocaml?! ;)
<f[x]> flux, read first, then comment
<flux> f[x], I read through the slides
<adrien> f[x]: I haven't looked at it in details but I'm pretty sure that some people would abuse it and use it to do dynamic typing
<f[x]> you can do dynamic typing right now
<f[x]> as it is a strictly less powerful subset of static typing
<flux> f[x], while that's technically true, for example mapping functions of varying arity, or records with varying fields, can be a pain to map into ocaml.
<f[x]> there is nothing dynamic in there, just a compiler-supported way for type reflection - which is currently done via camlp4
<f[x]> flux, extramely easy - record with varying fields == hashtbl, exactly the same as it is done in all dynamic languages
<flux> f[x], but the corresponding language will be awful. camlp4 could help there.
<f[x]> put some syntactic sugar of your choice and enjoy
<flux> you can write a function that can be called like: print "a"; or print 4;, and dynamically determine the tag in the 'print' function, is that not dynamic typing?
<f[x]> enjoy ruby-like
<f[x]> ruby-like speed
<flux> apparently some lisps have great performance.
<f[x]> flux: not of course
<bobry> yeah, deriving GUI widgets from data type does sound sexy ..
<bobry> flux: great for the time probably :)
<flux> bobry, well, how abouy SBCL compared to O'Caml? does well in shootout ;)
Anarchos has joined #ocaml
ikaros has joined #ocaml
Cyanure has quit [Ping timeout: 240 seconds]
benoit_ has joined #ocaml
Snark has joined #ocaml
Anarchos has quit [Quit: Vision[0.9.7-H-090423]: i've been blurred!]
<tomprince> adrien: I am guessing that some of the frustration isn't about the evolution of ocaml. it is the responsiveness to external patches, and transparency of the work being done by the core team.
rby has quit [Quit: Lost terminal]
<adrien> tomprince: yes, I think that's exactly that
rby has joined #ocaml
<adrien> bbl
Cyanure has joined #ocaml
roconnor has joined #ocaml
zorun has quit [Read error: Connection reset by peer]
roconnor has quit [Remote host closed the connection]
zorun has joined #ocaml
ankit9 has joined #ocaml
<thelema> flux: not dynamic types, runtime types
<thelema> flux: meaning that types don't get erased during compilation, but have a runtime representation.
mcclurmc has quit [Excess Flood]
mcclurmc has joined #ocaml
ankit9 has quit [Read error: Connection reset by peer]
ankit9 has joined #ocaml
ttamttam has quit [Read error: Connection reset by peer]
ttamttam has joined #ocaml
ttamttam has quit [Read error: Connection reset by peer]
ttamttam has joined #ocaml
ttamttam` has joined #ocaml
ttamttam has quit [Read error: Operation timed out]
ttamttam` has quit [Read error: Connection reset by peer]
ttamttam` has joined #ocaml
reynir has joined #ocaml
ikaros has quit [Quit: Ex-Chat]
ousado_ has joined #ocaml
ousado has quit [Ping timeout: 240 seconds]
ousado_ is now known as ousado
ousado has quit [Changing host]
ousado has joined #ocaml
Little`Endian has joined #ocaml
<Little`Endian> bonsjoir
<eikke> thelema: that proposal looks a lot like Haskell's Data.Typeable and friends to me
<Little`Endian> good afternoom
jonludlam has joined #ocaml
g0dmoney- has quit [Changing host]
g0dmoney- has joined #ocaml
<thelema> eikke: I expect it will tag every value with a type, including ints (to distinguish them from the empty list and variant types), whereas I'd guess that Data.Typeable applies only to those types that implement it.
<thelema> If we do tag every value with a type, the GC can make use of the type info to decrease its work and allow non-homogenous data representations (a lot of work, but some interesting payoffs)
<thelema> if we only tag some types, we can avoid the overhead of the tags when we don't need them, but lose things like generic printing and comparison
<f[x]> thelema, that proposal doesn't talk about tagging values with types iiuc
<thelema> f[x]: really? "runtime types" doesn't require tagging values with types?
<f[x]> `type of t` is a compile-time construct
<f[x]> it is a _runtime representation_ of types
<f[x]> which with the aid of the compiler is easier to obtain
<thelema> so it's as limited as the generic printer dimino wrote...
<f[x]> I would say it is more general but the principe looks same
<f[x]> tagging values is a no go anyway
<f[x]> at least naive tagging
<thelema> well, it's done in gocaml
<bitbckt> alain's first slide says: "I'm not proposing to attach type information to values"
<thelema> bitbckt: that'll teach me to comment w/o reading past first page
<bitbckt> :-)
<thelema> I don't see how to differentiate an int from a variant w/o attaching type information
<flux> I think it goes, optionally, with a separate argument.. but if it does that, it would mean it wouldn't work in all cases
<bitbckt> haha, he leaves it as an "exercise for the reader"
<bitbckt> tuples and sum types.
raichoo has quit [Quit: leaving]
Cyanure has quit [Remote host closed the connection]
<bitbckt> what I'm reading here is that it's essentially "module type of" for the core language.
<thelema> for example, inside a function that sorts arbitrary lists, the code decides it needs to print an element of the list...
<thelema> Can't what's being proposed be done in the style of dump, using Obj to inspect the representation and determine the type as much as possible from that?
<f[x]> dump already determines as much as possible
<f[x]> it is not enough
<thelema> yes, and it's horribly incomplete
<thelema> I'm still struggling to see how this will get any more out of a runtime value
<thelema> even the "automatic type representation arguments" can only work for types known statically
<bitbckt> right, since you need to generate that structural information statically.
<eikke> thelema: it only provides information about a type and allows to work with a type definition as a value, not related to values of the type
<bitbckt> type variables seem... particularly tricky.
ikaros has joined #ocaml
fcardona has joined #ocaml
<flux> apparently that requires an account
fcardona has left #ocaml []
<flux> I thought ocaml bugtracking was open..
<flux> so, what is the link about?
<thelema> hmm, you used to be able to login anonymously...
<thelema> apparently this is removed... jooky
<reynir> thelema: I believe I have found you on github :-)
<thelema> reynir: github.com/thelema
<reynir> Yes
<thelema> flux: short version of the link: pierre weis says http://pastebin.com/gPh1b5Yh
ulfdoz has joined #ocaml
<beginner> is there any circumstances where I should use `match x with`
<beginner> instead of `function` ?
<thelema> beginner: "function" = "fun x -> match x with"
<reynir> Yes
<flux> beginner, yes. when you already have the x.
<eikke> beginner: sure, as an expression
<beginner> k
<reynir> for example »let f i = match lookup i with Whatever -> true | SomethingElse -> false«
<beginner> reynir, lookup?
<zorun> any function you like :)
<zorun> he meant when you don't want to match the argument of the function directly
<beginner> ah okie
<zorun> but rather, an expression built from the argument
kuscotopia has joined #ocaml
sepp2k has joined #ocaml
larhat has quit [Quit: Leaving.]
<kuscotopia> I have a module called Graph which makes available a type called graph which is a record containing various types, one of which is a list of edges called edges. In a different module I have a function which takes a graph and attempts to access the edges field (graph.edges) but this results in an unbound field error. What am I doing wrong?
<thelema> graph.Graph.edges
<thelema> fieldnames are scoped to the record they're defined in
<thelema> since there might be multiple modules that define a field called edges, you have to either open the one you want or refer to it explicitly
<thelema> in order for type inference to work
<kuscotopia> Ah, alrighty. My hat is off to you once again thelema, thank you.
Kakadu has quit [Ping timeout: 248 seconds]
<thelema> it's a commonly asked question, it gets easier to recognize and answer each time.
<reynir> is it possible to "open" a module such that you only "open" some of it?
<thelema> reynir: yes, put the parts of the module you want to open in a submodule and only open that submodule
<reynir> Something like »open Graph.edges«-ish
<reynir> ah okay
<thelema> also, you can import single values into the current namespace with:
<thelema> let x = Module.x
<thelema> and type foo = Module.foo
<reynir> of course, thanks
eikke has quit [Ping timeout: 268 seconds]
ftrvxmtrx has quit [Quit: Leaving]
<thelema> how to get oasis to build a native "Executable"?
Kakadu has joined #ocaml
Kakadu has quit [Client Quit]
ttamttam` has quit [Remote host closed the connection]
reynir has quit [Ping timeout: 255 seconds]
ygrek has joined #ocaml
ankit9 has quit [Ping timeout: 252 seconds]
sebz has joined #ocaml
sebz has quit [Client Quit]
<kuscotopia> Is there a function like map for Hashtbl? I have seen sites that reference such..but Hashtbl.map is clearly undefined.
<thelema> kuscotopia: in batteries
<kuscotopia> batteries? I thought that was just a website name..is that some sort of module?
<thelema> it's an enhanced stdlib for ocaml
<thelema> grr, I need to fix the webpage - "latest release" still points at 1.2.2
<thelema> I'd use the current git tree anyway
<kuscotopia> ahh..is it common place to use that? Is there a better key/value type data that would support map in the common stdlib?
<thelema> yes, and Map
ftrvxmtrx has joined #ocaml
ankit9 has joined #ocaml
Anarchos has joined #ocaml
reynir has joined #ocaml
<rixed> thelema: the link to "Batteries moving to 2.0" is broken for me (leads to http://forge.ocamlcore.org/forum/forum.php?forum_id=818 -> give me a denied access error message (in french))
<thelema> rixed: odd, I don't think I made that link - a bug in the forge?
<thelema> maybe it's because that message isn't approved by gildor yet
<thelema> news has to be approved by him, iirc
ankit9 has quit [Quit: Leaving]
<rixed> thelema: I don't know how all this works. It says on batteries homepage that you entered this news today at 17:37.
<thelema> yup, europe time.
<rixed> So the 2.0 is out ?
<thelema> no, we're progressing towards 2.0.
<thelema> I'm doing a bunch of cleanup now, and wanted to get out the message that any cleanup that needs to be done should be done now.
<rixed> thelema: yes the message can actually be read in the forge NEWS page, yet the link (which leads to a forum) is broken. So the forum was not created but the news can be seen... :-/
<thelema> broken forge, I say.
<rixed> I'm always lost in forge GUI BTW.
<thelema> and people are confused when I say I prefer github
<kuscotopia> I hate to be that super needy fella, but I switched over to BatHastbl in my modules..and added -I /usr/lib/ocaml/batteries to my appropriate build lines. When I attempt to link my custom toplevel is see "Undefined global BatHashtbl". What do I need to do to have the top level pull in the proper .cmx?
<rixed> thelema: I agree that github make a better user front end, but conversations about patches are safer in the ML though.
<_habnabit> reposted from yesterday: http://i.imgur.com/nIGnb.png (line 3) <- anyone else have this issue with tuareg-mode? I'm not sure if it's an issue with tuareg-mode or color-theme
<thelema> kuscotopia: the right way to do this is with ocamlfind, not -I. But are you sure that batteries installed to /usr/lib/ocaml/batteries? I bet it installed elsewhere.
<rixed> kuscotopia: in similar occurences I compare my command line with the one of findlib --verbose :-)
<thelema> kuscotopia: if you want a batteries-enabled toplevel, copy the `ocamlinit` file from the batteries source tree to ~/.ocamlinit
<thelema> rixed: I'm still thinking about mailing lists' utility, especially the search-resistant ones on the forge...
<kuscotopia> I do see the files (cmi, cmx, etc) in /usr/lib/ocaml/batteries
<kuscotopia> let me try the ocamlfind...
<thelema> kuscotopia: try the ocamlinit first
emmanuelux has joined #ocaml
<kuscotopia> Alrighty
<rixed> kuscotopia: apart from the -I you added batteries.cma right?
<kuscotopia> That is probably the step I am missing
<rixed> kuscotopia: you are supposed to add this before your own modules IIRC
reynir has quit [Ping timeout: 252 seconds]
rixed is now known as rixed_AFK
<kuscotopia> Not sure what IIRC means..however that got me one step closer..ocamlemktop is now having an issue with an undefined global of CamomileLibrary
<thelema> kuscotopia: you have to include camomile for batteries 1.x
* thelema is going to merge v2 into master so that git head doesn't require camomile
<kuscotopia> I don't have a cma for Camomile
<kuscotopia> is this something i need to go find elsewhere?
<thelema> you needed camomile installed to compile batteries
<kuscotopia> Ah, I didn't compile..I pulled in from ubuntu repos
<thelema> and be aware that you're using a pretty old version of batteries
<kuscotopia> Added the text you suggested..same issue...I was going to use the vanilla repo version as I am stuck using an older version of ubuntu for my work
<kuscotopia> as I depend on a C shared library which was only ever built once with a specific glibc, etc
<kuscotopia> was hoping it would save me hassle in the long run :P
<thelema> kuscotopia: if you add the text I suggested to your ocamlinit, you don't need to build a custom toplveel
<thelema> just run `ocaml`
<kuscotopia> I was building a custom top level as I need to link in this c-library
<kuscotopia> or at least..I was under the impression I needed to
<thelema> kuscotopia: batteries has no C
<kuscotopia> I know..but Z3 (theorem prover I need for my project) is a C library interfaced to OCAML
<kuscotopia> I am building a toplevel so that I can use it
<thelema> ok, so you're working on building a custom toplevel for it. You should be able to ignore batteries for the purposes of building its toplevel
<thelema> and let findlib load batteries at startup
<kuscotopia> ahh
<kuscotopia> I see what you are getting at
<kuscotopia> that's clever
<kuscotopia> and probably basic..lol I just over looked that I could do that
<kuscotopia> Just linking in my z3 library and the .ocamlinit file seems to be doing the trick.
<kuscotopia> Thanks.
<thelema> no problem
<companion_cube> kuscotopia: i thought z3 had an ocaml interface?
<kuscotopia> It does, but it depends on the z3 shared lib
<kuscotopia> theu used some toolset to generate the interface to the c library
<thelema> kuscotopia: there may be a way to avoid building the custom toplevel, but if it works for you, keep doing that.
<kuscotopia> it has been working..but probably not for the reasons I think
<kuscotopia> I use ocamlmklib to tie the C shared libraries for z3 and the z3 ocaml interface files together
<kuscotopia> currently it outputs a cma that I pass in as input to my custom toplevel
<kuscotopia> *as input to ocamlmktop to generate my custom top level
sepp2k has quit [Ping timeout: 240 seconds]
<beginner> so pattern matching doesn't really work with floating point value?
<thelema> beginner: equality doesn't really work with floating point values
<_habnabit> nope. floats aren't exact; you need to do a delta-epsilon check
<_habnabit> let approx_equal ?(epsilon = 1e-5) f1 f2 = abs_float (f1 -. f2) < epsilon
<_habnabit> let (=~) = approx_equal
<_habnabit> ^ a useful thing
<thelema> match 1.25 with y when abs_float (y - 1.3) < epsilon -> ...
<thelema> _habnabit: mind if I adopt that into batteries. I've been meaning to write such a function for floats
<_habnabit> haha, no, go ahead
<_habnabit> I release that code into the public domain (because licenses matter)
<beginner> okie dokie, thanks
ygrek has quit [Ping timeout: 248 seconds]
sepp2k has joined #ocaml
_andre has quit [Quit: leaving]
roha has joined #ocaml
Drakken has left #ocaml []
Snark has quit [Quit: Quitte]
oriba has joined #ocaml
emmanuelux has quit [Remote host closed the connection]
emmanuelux has joined #ocaml
sebz has joined #ocaml
yezariaely has joined #ocaml
emmanuelux has quit [Remote host closed the connection]
ftrvxmtrx has quit [Quit: Leaving]
emmanuelux has joined #ocaml
<hcarty> thelema: Can we call it something other than ( =~ ) if you do include it in Batteries?
<thelema> hcarty: what name do you like?
<hcarty> If you do include the operator that is...
<hcarty> Not =~ because I use that for regex checks :-)
<thelema> yes, I've already committed the patch, but it's pretty painless to change.
<thelema> it won't be available by defalut
<thelema> and code that does regex checks is probably disjoint from code comparing floats for equality, so...
<hcarty> Oh, if it's in Float.Infix then I withdraw my request
<thelema> yes, only in Float.Infix
<hcarty> Is it possible to use optional parameters with an infix operator?
<hcarty> If not, is 1e-5 a reasonable epsilon?
<thelema> I don't know. I've never tried.
<hcarty> It doesn't look like it's possible
<hcarty> Well, this works: (1.0 =~ (1.0 -. 1e-5)) ~epsilon:epsilon_float
<hcarty> But that doesn't seem very useful
<hcarty> The inner () grouping is not required
<thelema> but the outer () is required? odd.
<thelema> I'd try it in my toplevel, but it seems I have one more bug to fix related to removing PMap
<hcarty> thelema: Yes, otherwise (1.0 -. 1e-5) is interpreted as a function taking a labeled argument
<thelema> let x = 1.0 and let y = 1.0 0. 1e-5 in x =~ y ~epsilon:epsilon_float
<hcarty> thelema: I think something was lost in the paste
<thelema> oops, -. instead of 0.
<thelema> just a typo
<hcarty> thelema: Same error
<hcarty> Error: This expression is not a function; it cannot be applied -- on y
elehack has joined #ocaml
<hcarty> The last y
<thelema> oops... "and let y"
<thelema> remove "let"
elehack has left #ocaml []
<hcarty> Yep, caught that one :-)
<hcarty> let x = 1.0 and y = 1.0 -. 1e-5 in x =~ y ~epsilon:epsilon_float
<thelema> doesn't work?
<hcarty> The last y is marked with the error above
<thelema> ok, I guess the () are needed
<hcarty> The same error I get with my earlier example
<thelema> in any case, if you need ~epsilon, you can use Float.approx_equal
<hcarty> The epsilon should probably be mentioned explicitly in the ( =~ ) documentation
<hcarty> Since it will only work for larger numbers
<thelema> added
<hcarty> thelema: What do you think of using <., >., =. for the generated comparison functions? Core does this for type-specific comparison functions.
<roha> All: How can I get the current absolute dir name, is that possible? Filename.current_dir_name returns "."
<hcarty> That avoids clobbering the default comparison functions
<thelema> hcarty: only for float, or for all numerics?
<roha> And is there a way to get all filenames from a dir?
<thelema> roha: probably within Unix, and Sys.readdir
<hcarty> thelema: For any module with comparison functions
sebz has quit [Quit: Computer has gone to sleep.]
<thelema> roha: Unix.getcwd ()
<hcarty> roha, thelema: Or the same function in Sys
sebz has joined #ocaml
<thelema> roha: so the answer to your questions is: Look in Sys
<thelema> hcarty: I don't like it so much for ints
<thelema> hcarty: hmm, and maybe chars (although I don't think we have this atm)
yezariaely has quit [Quit: Leaving.]
<roha> thelema: thanks! I was looking through all Battery modules and forgot that there is a std library as well. :)
<thelema> roha: :)
<hcarty> thelema: It provides a single-type comparison which could be handy
<thelema> hcarty: I don't want to encourage mixing of > with >.
<thelema> Not that there's much real harm in substituting one for the other, because it's either a slight performance loss or a type error
<thelema> hmmm...
<hcarty> I'm not sure which direction the performance loss would go.
<thelema> My expected use case for these functions is more as arguments for building maps or some other function
<thelema> hcarty: using < instead of Int.(<)
<hcarty> thelema: But ( < ) becomes visually and functionally distinct from Int.( <. )
<thelema> but that could be a pretty tricky performance bug to track down if the only difference was a .
<hcarty> If performance is an issue then the functorization can be pulled out
<thelema> (<) is already visually distinct from Int.(<)
<hcarty> But Int.( ... 1 < 2 .. ) is not very visually distinct from 1 < 2
<hcarty> Int.( ... 1 <. 2 .. ) is slightly more distinct and requires typing an extra character when one wants to be explicit
<thelema> yes, but this leads to the possible performance bug of doing Int.( .. 1<2 .. ) when you meant <.
pattern_ has joined #ocaml
pattern_ has left #ocaml []
<hcarty> I'm not convinced 1 < 2 is slower than 1 <. 2
<hcarty> <. has a small performance hit due to its functor origin
<thelema> hcarty: it doesn't have to, and if it does, I'll fix that now.
<roha> A general question: If you would want to print the contents of a string array to stdout, would you rather do this in a imperative loop or for example concat all strings via fold_left and then print the string?
<hcarty> thelema: Without <., you have that performance hit anyway
<hcarty> thelema: Infix.( < ) == ( < )
<adrien> fish?
<adrien> sorry :p
<thelema> eww, our infix comparators are pretty terrible - built off a parameter compare and then > 0, <= 0, etc.
<thelema> roha: for a large array, use iter
<thelema> roha: best is to just use Array.print Int.print stdout array
<thelema> err, String.print
<thelema> or with lots of fancy: Printf.printf "My Array: %a" (Array.print String.print) array
<thelema> (which is how I often print things)
<roha> thelema: Thanks i'll have a look at all those things
<hcarty> roha: Or use my xstprp4 fork and use "${array, Array.print String.print}
<hcarty> "
<hcarty> roha: That, of course, requires significantly more up-front effort than thelema's solution :-)
sebz has quit [Quit: Computer has gone to sleep.]
<roha> hcarty: I'll check it out if I won my current battle with the type checking system :). Thanks
sepp2k has quit [Remote host closed the connection]
Anarchos has quit [Quit: Vision[0.9.7-H-090423]: i've been blurred!]
sebz has joined #ocaml
sebz has quit [Client Quit]
Anarchos has joined #ocaml
Anarchos has quit [Client Quit]
Anarchos has joined #ocaml
<thelema> hcarty: It seems that the functorized compare is still much faster than polymorphic compare for Ints
<thelema> reversing the loops, I get comparable results: lt1 @557.52 us is 3.1% faster than lt3 @575.23 us is 59.3% faster than lt2 @1.41 ms
<hcarty> thelema: That's an impressively small difference between lt3 and lt1
<thelema> yup, within the std. dev of measurements.
<thelema> I need to think more about that final comparison summary (x is % faster than y ...)
<hcarty> That pokes some significant holes in speed-based arguments against functors
<hcarty> thelema: It takes a bit to parse initially
<thelema> maybe () instead of @
<hcarty> Once I figured out what it was saying (chained comparison) it makes sense
<hcarty> Yes, () seems like it could be more usable
<thelema> Maybe I should be doing significance testing at alpha=5% or something to determine "probably the same speed"
ulfdoz has quit [Ping timeout: 268 seconds]
reynir has joined #ocaml
<thelema> hcarty: does this look better? http://pastebin.com/5GAyrUAv
* thelema uploads a new version of bench to odb
<hcarty> thelema: That is easier to read
<hcarty> thelema: Maybe the second item on could have "which is n% faster than"
<thelema> hmm...
<hcarty> Specialized is n% faster than BatInt.Compare which is m% faster than Polymorphic
<thelema> is better grammar, but is it worth the extra junk in the printer
<hcarty> (... which is l% faster than Horrendous)
<hcarty> That's the piece I had the most trouble mentally parsing
<hcarty> It looked like the output was broken the first time I read it because the grammar is so unexpected
<hcarty> Knowing how to read it now I can follow it
<thelema> I have an easy way to add the "which"
<hcarty> But it was not immediately obvious
<thelema> although it's not going to make it into 1.1
<thelema> and I'm finding some more errors in removing BatPMap... fun
<hcarty> thelema: I'm off, but best of luck. Thanks for running those benchmarks!
<thelema> fixed (26.25 us) is probably same speed as
<thelema> hand (27.42 us) which is probably same speed as
<thelema> opt (28.62 us)
roha has quit [Remote host closed the connection]
emmanuelux has quit [Remote host closed the connection]
mcclurmc has quit [Excess Flood]
mcclurmc has joined #ocaml
emmanuelux has joined #ocaml
emmanuelux has quit [Remote host closed the connection]
emmanuelux has joined #ocaml
roha has joined #ocaml
emmanuelux has quit [Remote host closed the connection]
emmanuelux has joined #ocaml
Cyanure has joined #ocaml
<roha> Is it possible to use binary infix operators like ^ or + like this: (^"somestring") or (+3) for Array.map for example
<_habnabit> ((+) 3)
<thelema> _habnabit: beat me to it
<_habnabit> ocaml doesn't have sections like haskell, but you can partially-apply an operator
<_habnabit> operators are just functions
<_habnabit> (usually)
<roha> so ("asdf" ^ ) would work as well?
<roha> to append
<roha> preped i mean
<roha> prepend
<_habnabit> no.
<thelema> roha: no, you have to write that out
<thelema> (fun x -> "asdf" ^ x)
<_habnabit> (flip (^) "asdf")
<thelema> clarity vs. concision
<roha> so would you prefer the flip version or the lambda version?
<thelema> I imagine each of us prefers our own
<roha> kk then ill use flip :) thanks
emmanuelux has quit [Remote host closed the connection]
emmanuelux has joined #ocaml
emmanuelux has quit [Remote host closed the connection]
emmanuelux has joined #ocaml
<Anarchos> emmanuelux t'es en ipv6 ?
<emmanuelux> oui Anarchos
<Anarchos> emmanuelux t'es le premier que je vois ca fait bizarre
<emmanuelux> non free y ait passe
<emmanuelux> avec la freebox
<Anarchos> ca change rien au fait que tu es le premier que je croise en ipv6 :)
<Anarchos> bon aller dodo time
<emmanuelux> je vais t en trouver des freenautes moi
<Anarchos> emmanuelux bonne nuit :)
<Little`Endian> Bonne nuit
Anarchos has quit [Quit: Vision[0.9.7-H-090423]: i've been blurred!]
Little`Endian has quit [Quit: WeeChat 0.3.5]
edwin has quit [Remote host closed the connection]
ikaros has quit [Quit: Ex-Chat]
ikaros has joined #ocaml
<roha> ahem, BatPrint.printf "Integer: %i" 2 gieves me: Error: This expression has type string but an expression was expected of type
<roha> BatPrint.format ('a -> 'b) unit, eventhough im pretty sure that's the same as in the API. What did I do wrong?
<thelema> %d
<thelema> also, BatPrintf, not BatPrint
<roha> ah thanks, tried that as well. The error lied in the use of BatPrint instead of BatPrintf
<thelema> batprint is used for a different kind of printing that iirc, hcarty can tell you more about.
<thelema> it involves camlp4 magic, so I try to avoid it
<roha> ok, i came to it because i think there was written somewhere that BatPrintf is obsolete and one should us BatPrint. But probably i've just misread that.
reynir has quit [Ping timeout: 252 seconds]
<roha> It's really awesome how programs tend to work correctly if the type checker is ok with it. I'm used to C++ where a compiled program can be completely bug infested. Well, I'm not good at C++ to be fair.
sebz has joined #ocaml
sebz has quit [Client Quit]
<_habnabit> don't get confused and think that a strict type system means you don't have to write tests
emmanuelux has quit [Remote host closed the connection]
<roha> of course, and i was only doing small trivial things. but still, i like it.
emmanuelux has joined #ocaml
Morphous has quit [Ping timeout: 244 seconds]
sebz has joined #ocaml
emmanuelux has quit [Remote host closed the connection]
emmanuelux has joined #ocaml
Morphous has joined #ocaml
emmanuelux has quit [Remote host closed the connection]
emmanuelux has joined #ocaml
emmanuelux has quit [Client Quit]
yroeht has quit [Ping timeout: 268 seconds]
sebz has quit [Quit: Computer has gone to sleep.]
yroeht has joined #ocaml
sebz has joined #ocaml
sebz has quit [Client Quit]
emmanuelux has joined #ocaml
Cyanure has quit [Remote host closed the connection]
milosn_ has joined #ocaml
milosn has quit [Ping timeout: 244 seconds]
sebz_ has joined #ocaml
sebz_ has quit [Quit: Computer has gone to sleep.]
oriba_ has joined #ocaml
oriba has quit [Ping timeout: 255 seconds]
roha has quit [Remote host closed the connection]
destrius has joined #ocaml
kuscotopia has quit [Remote host closed the connection]