gildor changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | OCaml 3.12.0 http://bit.ly/aNZBUp
joewilliams is now known as joewilliams_away
Edward has quit []
_unK has quit [Remote host closed the connection]
Axsuul has quit [Ping timeout: 250 seconds]
ftrvxmtrx has quit [Remote host closed the connection]
ftrvxmtrx has joined #ocaml
wuj has quit [Ping timeout: 265 seconds]
easy4 has joined #ocaml
ftrvxmtrx has quit [Ping timeout: 265 seconds]
ftrvxmtrx has joined #ocaml
ViciousPlant has joined #ocaml
ftrvxmtrx has quit [Ping timeout: 265 seconds]
ftrvxmtrx has joined #ocaml
mjonsson has quit [Remote host closed the connection]
manveru has joined #ocaml
<manveru> heya
<manveru> i'm just learning ocaml, and found some odd behaviour: let avg a b = a +. b / 2.0;; tells me that it expected int?
<dark> manveru, let avg a b = a +. b /. 2.0;;
<dark> / is integer division (int -> int -> int), /. is floating point division
<dark> yes, odd
<manveru> oh
<manveru> i overlooked the dot, thanks :)
<dark> :)
<manveru> i wish the error message was a bit better :)
<adrien> mmmm
<adrien> parens?
<manveru> at least telling me what function expected it
<adrien> hcarty: I've started using it with lablgtk (and more generallly, APIs with side-effect) pretty successfuly but now I need to "blend" several signals/events into a single one: react provides that for {1,6}-uplets but I need it for arbitrary records
<adrien> it took me quite some time to find "clear" words what I actually need
<adrien> manveru: also, a + b / 2 is understood as : a + (b / 2), not (a + b) / 2
<manveru> yeah, parens too, i actually transformed it from: var sum = a +. b in sum /. 2.0
ikaros has joined #ocaml
<manveru> right now i'm trying http://ocaml-tutorial.org/ but i'd prefer something more CLI oriented, does anybody have suggestions for me?
<adrien> CLI-oriented? what do you mean exactly?
<manveru> console interaction, reading stdin, writing stdout...
<manveru> just basics :)
<manveru> for example i found: print_float 2.0; print_newline ();; but cannot believe that's the best way to output a float
<adrien> I think it's coming a bit later on
<adrien> writing will be print_endline/Printf.printf
<adrien> reading, it depends
<adrien> could start with input_line mostly
<adrien> read_line / input_line stdin
<adrien> (one or the other)
<manveru> hm
<manveru> now i have some strange behaviour
<manveru> my file is: print_endline (read_line ())
<manveru> and it outputs "\n3.5\n"
<manveru> without asking for input even
<adrien> too early in the morning to really think
<adrien> and if you call it a second time?
<manveru> heh
<manveru> same
<manveru> oh
<manveru> i used `ocamlopt -i -o ...`, using just `ocamlopt -o ...` works
<adrien> -i doesn't do what you think
* adrien late
jakedouglas has quit [Quit: Leaving.]
ikaros has quit [Quit: Leave the magic to Houdini]
dark has quit [Ping timeout: 276 seconds]
ftrvxmtrx has quit [Ping timeout: 240 seconds]
ygrek has joined #ocaml
ftrvxmtrx has joined #ocaml
ttamttam has joined #ocaml
ygrek has quit [Ping timeout: 245 seconds]
dark has joined #ocaml
ygrek has joined #ocaml
yezariaely has joined #ocaml
<dark> does ocaml have something like -D from C compilers?
<dark> to pass string constants at compile time
ftrvxmtrx has quit [Quit: Leaving]
<dark> another option is to generate a .ml in the build process but this could confuse omake
<rwmjones> not really ... I usually generate a config.ml file at compile time. Alternative is to use one of the macro camlp4 packages, but that's going to be much less straightforward than generating a .ml
Gooffy has joined #ocaml
jjong has joined #ocaml
ftrvxmtrx has joined #ocaml
ygrek has quit [Ping timeout: 245 seconds]
ftrvxmtrx has quit [Read error: Connection reset by peer]
ftrvxmtrx has joined #ocaml
<junis> ça veut dire quoi l'expression se sauver les meubles
<sgnb> je connais "sauver les meubles", mais pas "_se_ sauver les meubles"
<sgnb> (et quel est le rapport avec le topic de ce chan ? )
<sgnb> junis: ^^^
<junis> oh pardonne moi s'il te plait sgnb... j'avais pas l'intention de te gacher le séjour...
<dark> is there some standard way to get the home directory?
<junis> ~
<yezariaely> lol
<dark> in ocaml, not bash!
<sgnb> dark: Sys.getenv "HOME" ?
<dark> uhm interesting
<junis> ouais .. ça marche
<dark> I was looking at batteries Unix, but they have the ugly habit of not putting help for already existing functions
<dark> .-.
<dark> there is Unix.getenv that is the same as Sys.getenv
th5 has joined #ocaml
<junis> holy moses ... i'm in the wrong buffer
* junis laughs
<junis> sorry sgnb
<sgnb> ...
Yoric has joined #ocaml
dark has quit [Ping timeout: 245 seconds]
dark has joined #ocaml
ViciousPlant has left #ocaml []
_andre has joined #ocaml
ygrek has joined #ocaml
munga has joined #ocaml
Pepe_ has quit [Ping timeout: 265 seconds]
stdDoubt has joined #ocaml
<stdDoubt> how to structure the files when using objects in ocaml? (one object per ml file? or "use" the file as package in java?)
<stdDoubt> how to structure the files in a mixed approach(modules and classes)?
<gildor> stdDoubt: one object per ml file seems too much
<gildor> stdDoubt: I think that for object/modules, you can have one module per data + operation
<gildor> stdDoubt: if the module/object is generic and used in more than a single module/file -> use its own file
<stdDoubt> we can have a specific signature of a module in a file and other other modules using that sig right?
<gildor> yes
<stdDoubt> thanks
zubeen has joined #ocaml
dark has quit [Ping timeout: 245 seconds]
<flux> stddoubt, I once used a single module for defining module types and then separate modules for each class
<flux> it worked fine. the main advantage was bypassing the issues with class definitions depending on each other in a non-hierarchical manner.
dark has joined #ocaml
kaustuv has joined #ocaml
mattam has joined #ocaml
dark has quit [Ping timeout: 240 seconds]
Amorphous has quit [Ping timeout: 240 seconds]
Tianon has quit [Ping timeout: 272 seconds]
Tianon has joined #ocaml
Tianon has quit [Changing host]
Tianon has joined #ocaml
npouillard has quit [Ping timeout: 272 seconds]
npouillard has joined #ocaml
ygrek has quit [Remote host closed the connection]
CoryDambach has quit [Read error: Connection reset by peer]
CoryDambach has joined #ocaml
Amorphous has joined #ocaml
eelte has quit [Ping timeout: 255 seconds]
munga has quit [Ping timeout: 252 seconds]
munga has joined #ocaml
yezariaely has left #ocaml []
fraggle_ has quit [Ping timeout: 276 seconds]
wuj has joined #ocaml
Gooffy has quit [Quit: Leaving.]
boscop_ has joined #ocaml
rixed_ has joined #ocaml
boscop has quit [Ping timeout: 260 seconds]
<stdDoubt> what is the main drawback of objects regarding the module system?
<sdschulze> Is this a general modules vs. classes debate?
jakedouglas has joined #ocaml
<stdDoubt> my doubt concerns extensibility. I am starting a new project and I am doing the analysis - (In the future there might be some requirement changes)
<sdschulze> It's an OCaml project?
<stdDoubt> I was wondering when to use what (modules/objects)
<stdDoubt> yes
<sdschulze> The one advantage of modules is that OCaml supports them better.
<flux> a lot of the time when with onjects you would use class hierarchies, in fp you use higher order functions
<stdDoubt> should we mix both?
<flux> one issue with traditional oo type systems is that it can easily introduce high coupling between classes
<sdschulze> It has all the kinky features like functors.
<rixed_> in practice, modules a (a lot) faster since there is no dispatcher.
<flux> of course, structural type systems, such as ocaml's, can sortg of sidestep those issues
<stdDoubt> speed is not a major concern for this project but maintainability is
<flux> sometimes people (I ;-)) use objects is that they can use the neat #-notation instead of opening or locally aliasing other modules
<flux> the downside is that it's more difficult to tell what code a#b really calls
<flux> whereas A.b a can be lexically determined to call a certain function
<sdschulze> stdDoubt: What the OOP folks call "encapsulation" is sometimes good, sometimes it isn't.
<orbitz> stdDoubt: fwiw, jane st avoids the class system for the most part
<sdschulze> That's why I don't like the Java standard library: operations on standard data types should *not* be encapsulated.
<stdDoubt> why not?
<sdschulze> stdDoubt: Because it stops me from -- say -- implementing my own string library. Well, I could make a subclass of "String", but that's ugly.
Pepe_ has joined #ocaml
<sdschulze> Modules are more transparent. The disadvantage is that you can't "overload" them. (at least not in OCaml)
<sdschulze> overload functions, that is
<gildor> sdschulze: why you cannot overload them ?
<stdDoubt> from my experience I don't consider overloading a good thing
<sdschulze> gildor: no ad-hoc polymorphism
<gildor> module Toto = struct include Titie let fun_overload = ... end
<gildor> ah overload like in C++
<sdschulze> yes, should've mentioned that
<gildor> you can do even more clever thing with OCaml 3.12
<orbitz> stdDoubt: from what monksy has said, they avoid the object system because it makes it hard to know what code you are calling (and they need that to be easily inferrable)
<gildor> (i.e. renaming overlapping types)
<gildor> stdDoubt: the object system of OCaml is nice, but let say that this is probably not the best point of OCaml
<gildor> stdDoubt: if you want an ultra-advanced OO language, OCaml is not the best choice
<sdschulze> Objects aren't "first-class citizens", the OCaml tutorial would say.
<orbitz> honestly, in functional languages i find very few situatiosn where I care about classes
<orbitz> certainly it's not something i design a programa roudn
<orbitz> any more than i'd design a progarm around floats
<sdschulze> I abused the object system a lot when I starting with OCaml -- because that was something I knew.
<stdDoubt> you can always also design it around modules but for instance you lose in inheritance and code re-usability
<sdschulze> But OCaml's parametric polymorphism pretty much eliminates the need for objects.
<orbitz> i reuse ode more in most FP languages than I do in an OO languaeg
<orbitz> look at java's collections, a complete cluster fuck of code duplication
<gildor> stdDoubt: don't want to enter into "religious war" but code reusability as made in OO is probably not a very good choice
<flux> objects are nice when you want to pas a bunch of related operations
<flux> also, inheritance is sometimes nice :)
<gildor> stdDoubt: you should watch this video http://video.google.com/videoplay?docid=-2336889538700185341&hl=en#
<gildor> stdDoubt: Y. Minsky explain some problem with code reusability as done in Jave, it is quite instructive
<orbitz> gildor: great video
<stdDoubt> gonna see it
<sdschulze> flux: I'm not exactly a Haskell fan, but I do like their type classes.
<gildor> type classes are nice, but are probably next level
<orbitz> you can do explicit typeclasses in ocaml
<gildor> OCam type system cover already a lot of things
<orbitz> part of the beauty of ocaml is you may have to be a bit more explicity but the simplicity of the language makes it beauitul IMO
<stdDoubt> I am coming from a oop environment for the last 7 years and I think ocaml can help me quite a lot in the project I am working now
<orbitz> stdDoubt: If the talk I saw on CUFP is accurate, expect it tto take an 8 - 12 months to get proficient at writing 'functional' code
<gildor> orbitz: which talk ?
<orbitz> gildor: the one from the Intel guys, i forget their name. They said for someone with non-FP programing experience it atkes a good 8 - 12 months to realign their thinking
<stdDoubt> I need to remember some concepts so I hope it will take less time
<gildor> stdDoubt: you can quickly get some basic knowledge with OCaml, but it will take a longer time to think FP
<sdschulze> gildor: Is overloading modules actually useful? Shouldn't use just use the one function from the one class and the other function from the other class?
<sdschulze> +you
<gildor> sdschulze: that can be very useful if you want something quite near to the original one
<gildor> sdschulze: e.g. a MapModule that return a default value rather than "Not_found"
<gildor> sdschulze: but it is probably not recommend to do it on a very largescale
<gildor> (other example include what has been done in batteries/extlib to extend stdlib
<gildor> )
<orbitz> in janest core you can do open Core.Std or open Core_extended.Std to replace your std lib with a 'saner' one
<sdschulze> The bad thing is that Java *forces* you to use classes for everything -- whether it makes sense or not.
<orbitz> and java's classes are horribly broken
<sdschulze> they are?
<orbitz> you end up having to make a bunch of concessions, take the collections or math 'classes', they are basically just name spaces so they are fairly useless in a larger program structure
<sdschulze> Ah, OK, so the way classes are abused is bad, not the class system itself.
<sdschulze> (disclaimer: I only know Java from the theoretical POV)
joewilliams_away is now known as joewilliams
ccasin has joined #ocaml
avsm has joined #ocaml
<stdDoubt> one doubt that I have is there any way of structuring modules (like in python with packages and modules)?
th5 has quit [Quit: th5]
avsm has quit [Quit: Leaving.]
DimitryKakadu has joined #ocaml
<hcarty> gildor: ocamlmpi is in GODI now, and hopefully working properly.
<gildor> hcarty: with patches, I suppose
<gildor> maybe we could do a release
<gildor> stdDoubt: packages in OCaml, that look like Java one, are done using -mlpack
<gildor> stdDoubt: this is not a commonly used option, though and is not perfectly integrated with some tools
<hcarty> gildor: Yes, with a few patches. I think it would worth making a few extra changes before a release
<hcarty> gildor: The to (somewhat) large changes I propose are (1) convert comments in mpi.mli to ocamldoc comments and (2) update the build system
<hcarty> ocamlmpi in its current state doesn't seem to work in the toplevel from what I can tell.
<hcarty> gildor: The GODI package currently uses a patched snapshot of the code
boscop_ is now known as boscop
avsm has joined #ocaml
<gildor> hcarty: not in the toplevel, I am not surprised
<gildor> can you submit a bug to the BTS about comments and submit patches you already have and that I don't yet have applied
<gildor> ?
<hcarty> gildor: Yes, will do - it may take me a little while to get a chance to do so, but I will as soon as possible.
<gildor> hcarty: take your time, I am preparing OASIS v0.2 release, so I am pretty busy
joewilliams is now known as joewilliams_away
srcerer_ is now known as srcerer
ftrvxmtrx has quit [Quit: Leaving]
ikaros has joined #ocaml
<hcarty> Is it possible to make a function like : val make : (module M) -> (M.t -> unit) * (unit -> M.t)
<hcarty> I think I remember seeing a blog post or article about using 3.12's first class modules for this, but I haven't been able to find it
joewilliams_away is now known as joewilliams
<rossberg> hcarty: no, when there are type dependencies between argument and result like that you need to use a functor
<hcarty> rossberg: Ok, thanks. I wasn't sure if there was a way to pull it off using first class modules.
lpereira has joined #ocaml
avsm has quit [Quit: Leaving.]
<hcarty> It does seem to be possible using first class modules if a bit of extra annotation is used
stdDoubt has quit [Quit: Leaving]
ygrek has joined #ocaml
coucou747 has joined #ocaml
monra has joined #ocaml
<monra> Hello. I try to compile an ocaml file but it prints me an error on a line after the end of the file. So let's say my file has 100 lines, ocaml says i have an error at line 101. If I compile one-by-one each function of the file they are compiled just fine. Any ideas why this might be?
munga has quit [Read error: Operation timed out]
<adrien> monra: probably a syntax error with an unmatched let...in/let or ;; or parens or ...
<adrien> can you pastebin the file?
init1 has joined #ocaml
<monra> adrien: yup. Here you are: http://opensuse.pastebin.com/MmxdE2HA
<adrien> you don't need (read, "don't *want*") the semicolons (';')at the end of function definitions
<adrien> monra: actually, I should have said "don't need", it's definitely an error to use them
ulfdoz has joined #ocaml
<adrien> do you understand the use of ';' when you write 'incr x;'? it's the same if you put that at the end of a function
<monra> adrien: Ok thanks :). Let me try without them
<adrien> did something made you put them (like trying to solve another problem)?
<monra> adrien: Well the next() function wasn't written by me although all the others where. In the beginning I used ';;' and It didn't compile, by using one ';' I thought I reduced the errors :S
<monra> were*
<adrien> heheh :p
<adrien> ';;' is quite "strong": when you write "some code;; some other code;;", it means that you could split the code into two files and still get something _syntactically_ correct (not saying anything about the correctness)
<adrien> for instance, you wouldn't be able to use ';;' in the middle of a function
mjuad is now known as _mjuad
<adrien> its use in the toplevel is special because it's required to tell the toplevel to start interpreting what you'e entered but it's not required when compiling files
<orbitz> I have module M = Map.Make(String);; can I not do M.fold where I take in a String -> int map and make a String -> String map?
<monra> adrien: I see. Thank you very much :). I fixed the problem and now it compiles just fine! Thank you!
<hcarty> orbitz: Why not use M.map?
<orbitz> hcarty: yeah i was just tryign to get a testcase, i see where i mssed up though
<orbitz> i keep on thinkng M.fold takes map to fold over as last argument
<adrien> monra: =)
ftrvxmtrx has joined #ocaml
ttamttam has left #ocaml []
avsm has joined #ocaml
roconnor has joined #ocaml
<roconnor> what are recommended tutorials for ocaml for students not necessarily familar with functional programming?
Yoric has quit [Quit: Yoric]
<roconnor> \o/
xcthulhu has quit [Quit: Ex-Chat]
DimitryKakadu has quit [Ping timeout: 240 seconds]
ygrek has quit [Ping timeout: 245 seconds]
mgiovann has joined #ocaml
<mgiovann> Hello all!
<adrien> morning :-)
<mgiovann> Afternoon ;-)
<adrien> it's actually 8:30*p*m here ;-)
yezariaely has joined #ocaml
yezariaely has left #ocaml []
ztfw has joined #ocaml
avsm has quit [Quit: Leaving.]
Snark has joined #ocaml
<mgiovann> I'm stumped with something I don't know how to solve
ulfdoz_ has joined #ocaml
<mgiovann> I'm translating the Iteratee code from the Monad.Reader, and I got an instance where the type is not as general as it should be
<mgiovann> With these types:
<mgiovann> type 'i stream = Empty | EOF | Data of 'i
<mgiovann> type ('i, 'o) iter = Done of 'o * 'i stream | Cont of ('i stream -> ('i, 'o) iter)
<mgiovann> and this function
<mgiovann> let rec drop n = let rec step = function | Data _ -> drop (pred n) | Empty -> Cont step | EOF -> Done ((), EOF) in if n = 0 then Done ((), Empty) else Cont step
<mgiovann> drop 0 has type:
<mgiovann> - : ('_a, unit) iter = Done ((), Empty)
<mgiovann> And I don't see why it should
ygrek has joined #ocaml
<thelema> hmm, everything's a function, no refs... I don't see either
ulfdoz has quit [Ping timeout: 264 seconds]
ulfdoz_ is now known as ulfdoz
<thelema> ah, non-functional values can't have full polymorphic type.
<thelema> well, almost...
monra has quit [Quit: leaving]
<mgiovann> # let unit = Done ((), Empty) ;; val unit : ('a, unit) iter = Done ((), Empty)
<mgiovann> Almost :-)
<mgiovann> The closure in Cont is doing funny things to my type. I tried eta-expanding all continuations, but to no avail
<mgiovann> Another thing is that I have fully polymorphic monadic bind, but if I use it the type gets narrowed to a deferred monomorphic type
init1 has quit [Quit: Quitte]
<thelema> let unit x = let f = fun _ -> 2 in Done ((), Empty) in unit 2;;
<thelema> - : ('_a, unit) iter = Done ((), Empty)
<thelema> try hoisting step outside drop
<mgiovann> let rec step n str = if n = 0 then Done ((), Empty) else match str with | Data _ -> Cont (step (pred n)) | Empty -> Cont (step n ) | EOF -> Done ((), EOF)
<mgiovann> (it's essentially equivalent)
<mgiovann> # step 0 ;; - : '_a stream -> ('_a, unit) iter = <fun>
<thelema> I was thinking two mutually recursive functions...
<mgiovann> Yeah, but it's not really necessary (C.D. Smith gives essentially this definition)
<mgiovann> # step 0 Empty ;; - : ('_a, unit) iter = Done ((), Empty)
<mgiovann> :-?
<mgiovann> I guess I'll meditate a while to see if I can channel Oleg :-)
<thelema> sure, but ocaml's typing doesn't go to great lengths to un-_ types
<mgiovann> Oh, I forgot to mention, this is with 3.12
olauzon has joined #ocaml
<mgiovann> Eta-expanding the top-level partial application works
<mgiovann> It's miffing, because these are reified continuations, the point is not to eta-expand to apply them
<mgiovann> Meaning that even if (>>=) is polymorphic, it >>= fun _ -> it' is not
thieusoai has quit [Remote host closed the connection]
_andre has quit [Quit: *puff*]
lpereira has quit [Ping timeout: 255 seconds]
avsm has joined #ocaml
Tobu has joined #ocaml
Snark has quit [Quit: Ex-Chat]
_unK has joined #ocaml
lpereira has joined #ocaml
<junis> # Sys.time ();;
<junis> - : float = 0.196415999999999979
<junis> i totally adore it
* junis laughs
<adrien> it gives you the cpu time used by your process :-)
ztfw has quit [Remote host closed the connection]
Modius has joined #ocaml
<junis> ocaml floats are double or single precision?
<hcarty> junis: Double
<junis> thank you hcarty
<hcarty> You're welcome
avsm has quit [Quit: Leaving.]
roconnor has quit [Remote host closed the connection]
drunK has joined #ocaml
_unK has quit [Ping timeout: 276 seconds]
<hcarty> thelema: One of the Batteries syntax extensions seems to have a problem with this function definition: let f (type s) m = let module M = (val m : S with type t = s) in let f (x : s) = x in f;;
<hcarty> thelema: It prints a (seemingly) infinite series of (
<hcarty> when entered in the toplevel
<hcarty> Is there anyone here with Batteries and OCaml 3.12 who can confirm?
mgiovann has quit [Quit: Page closed]
<hcarty> http://ocaml.pastebin.com/vEk4fvFL -- this consistently gives me the problem (be ready with Ctrl-C...)
ulfdoz has quit [Ping timeout: 240 seconds]
hto has quit [Read error: Connection reset by peer]
hto has joined #ocaml
krankkat1e has quit [Quit: leaving]
ygrek has quit [Ping timeout: 245 seconds]
boscop_ has joined #ocaml
lpereira has quit [Quit: Leaving.]
drksd has joined #ocaml
hyperbor1ean has joined #ocaml
bacam_ has joined #ocaml
avsm has joined #ocaml
bacam has quit [Disconnected by services]
bacam_ is now known as bacam
ftrvxmtrx has quit [*.net *.split]
boscop has quit [*.net *.split]
junis has quit [*.net *.split]
LionMadeOfLions has quit [*.net *.split]
rks has quit [*.net *.split]
rwmjones has quit [*.net *.split]
hyperboreean has quit [*.net *.split]
drksd is now known as rks
ftrvxmtrx has joined #ocaml
LionMadeOfLions has joined #ocaml
rwmjones has joined #ocaml
boscop_ is now known as boscop
<ftrvxmtrx> hcarty, confirming, saw the same thing yesterday while playing with first class modules
<hcarty> ftrvxmtrx: Thanks! I submitted a bug in the Batteries bug tracker
joewilliams is now known as joewilliams_away
ikaros has quit [Quit: Leave the magic to Houdini]
ccasin has quit [Quit: Leaving]
joewilliams_away is now known as joewilliams
olauzon has quit [Quit: olauzon]
Edward_ has joined #ocaml
drunK has quit [Remote host closed the connection]
avsm has quit [Quit: Leaving.]
avsm has joined #ocaml
Edward_ has quit []
avsm has quit [Quit: Leaving.]
ssice has joined #ocaml
mjonsson has joined #ocaml
ssice has left #ocaml []