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
avsm has joined #ocaml
romanoffi has joined #ocaml
avsm has quit [Quit: Leaving.]
f[x] has quit [Ping timeout: 240 seconds]
<manveru> so... is there any way to make a function that takes int | float and returns the string representation?
<manveru> my first attempt is http://gist.github.com/633564
<manveru> but i wonder if it's possible without the `Int/`Float boilerplate
julm has quit [Ping timeout: 245 seconds]
<thelema> manveru: your use of tagging is the required way to do this in ocaml
<thelema> ocaml's types are erased during compilation, so you have to explicitly mark values with their type to o what you want
julm has joined #ocaml
julm_ has joined #ocaml
_mjuad has quit [Quit: changing servers]
_mjuad has joined #ocaml
<manveru> nice... ocamlbrowser picks up the stuff in the current directory...
jakedouglas has quit [Quit: Leaving.]
<manveru> my first attempt at mandelbrot: http://ideone.com/vp6fy
ulfdoz has joined #ocaml
<thelema> manveru: isn't bailout=4 sufficient?
<thelema> and your x/y are reversed from usual, but otherwise quite nice.
<manveru> hm, yeah
<manveru> sorry, i did the translation from an old dylan implementation i made
<manveru> doesn't really impact the runtime
<manveru> and the y/x i blame on years of curses ^^;
<thelema> If you wanted, you could do [print_char (if i=0 then '*' else ' ')]
julm_ has quit [Quit: leaving]
<thelema> or even use pattern matching to handle ranges - #, *, ., ' '
<manveru> heh
<manveru> how do i match ranges?
<thelema> You could clarify the return value from [mandelbrot] by using a variant type : In_set | Escapes of int
<thelema> match i with x when x > 100 -> # | x when x > 50 -> * | ...
<manveru> right
<thelema> it's equivalent to nested ifs, but maybe easier to red
<thelema> *read
Modius has quit [Ping timeout: 265 seconds]
ulfdoz has quit [Ping timeout: 255 seconds]
ulfdoz has joined #ocaml
Modius has joined #ocaml
wuj has quit [Ping timeout: 265 seconds]
ikaros has joined #ocaml
_mjuad has quit [Ping timeout: 265 seconds]
wuj has joined #ocaml
ulfdoz has quit [Ping timeout: 252 seconds]
ikaros has quit [Quit: Leave the magic to Houdini]
wuj has quit [Ping timeout: 265 seconds]
hyperbor1ean has quit [Quit: leaving]
hyperboreean has joined #ocaml
ygrek has joined #ocaml
Yoric has joined #ocaml
CoryDambach has quit [Read error: Connection reset by peer]
Gooffy has joined #ocaml
CoryDambach has joined #ocaml
f[x] has joined #ocaml
ygrek has quit [Ping timeout: 245 seconds]
ygrek has joined #ocaml
easy4_ has joined #ocaml
easy4_ has quit [Client Quit]
easy4 has quit [Ping timeout: 245 seconds]
ttamttam has joined #ocaml
lamawithonel has joined #ocaml
Yoric has quit [Quit: Yoric]
ftrvxmtrx has quit [Quit: Leaving]
junis has joined #ocaml
<junis> greetings fine people
munga has joined #ocaml
Yoric has joined #ocaml
ygrek has quit [Ping timeout: 245 seconds]
munga has quit [Read error: Operation timed out]
Julien_T has joined #ocaml
Snark has joined #ocaml
Snark has quit [Remote host closed the connection]
zubeen has quit []
munga has joined #ocaml
z77z has joined #ocaml
_andre has joined #ocaml
jonathandav has quit [*.net *.split]
jlouis has quit [*.net *.split]
jonathandav has joined #ocaml
jlouis has joined #ocaml
sepp2k has joined #ocaml
oriba has joined #ocaml
oriba has quit [Client Quit]
munga has quit [Ping timeout: 255 seconds]
vk0 has joined #ocaml
ftrvxmtrx has joined #ocaml
munga has joined #ocaml
fraggle_ has joined #ocaml
mikemc has quit [Ping timeout: 272 seconds]
z77z has quit [Remote host closed the connection]
ssice has joined #ocaml
Amorphous has quit [Ping timeout: 245 seconds]
ssice has quit [Quit: ssice]
ssice has joined #ocaml
Gooffy has left #ocaml []
Amorphous has joined #ocaml
dark has joined #ocaml
<dark> can I open just some functions of a module?
<ssice> I don't think so...
<ssice> open makes definitions inside some <identifier>.something avaliable on the global scope
<ssice> I don't think you can
<thelema> [let local_fun = Module.function]
<ssice> but you can always overwrite what you want
<ssice> ...as <thelema> has just told before I could end my phrase : )
<thelema> dark: only one at a time,
<ssice> you can iterate over a list of what you want to "open"
ssice has quit [Quit: ssice]
<dark> yes, i'm doing let a = A.a
<dark> over a list?
<dark> Ithink i'm looking for a syntax extension then..
<dark> (Well, I can't iterate over a list of lexical symbols, without a syntax extension)
<thelema> dark: correct
<thelema> the more common way to limit what gets opened from a module is to give that module a spec - a .mli file to hide the parts you don't want.
<thelema> another good way to do this is to rename the module, so it's easier to give a full path: [module L = List]
<dark> what I want is to open Unix, but without all Unix things
<thelema> why not?
<thelema> why not [open Unix]?
<dark> I used to never open a module, and fully qualify everything, but now the code seems easier to follow without this
<flux> maybe you could use 3.12 syntax extension in a sparing manner: open Foo in expr ?
<flux> I've learned to avoid opens, it's easier to find the source that way
<dark> I'm using, for now, just Unix.mkdir (and will use other things I think), and other functions from Sys. Unix shadows some things from Sys..
<flux> also if you have a slightly larger project, having a module that defines the shortcuts in a central fashion is a good idea
<dark> hm
<dark> I think I'm liking the import syntax of haskell
ttamttam has quit [Remote host closed the connection]
_andre has quit [Ping timeout: 265 seconds]
ssice has joined #ocaml
_andre has joined #ocaml
pozic has joined #ocaml
pozic has quit [Changing host]
pozic has joined #ocaml
<pozic> What exactly is the compilation strategy of the native code OCaml compiler and why is its code not as bad as one would expect from a non-optimizing compiler?
boscop_ has joined #ocaml
munga has quit [Ping timeout: 250 seconds]
<thelema> ocamlopt doesn't do a lot of rewriting of the input program to attain speed, most of its speed is from good data representation and very local optimizations
boscop has quit [Ping timeout: 240 seconds]
ssice has quit [Quit: ssice]
wuj has joined #ocaml
boscop_ is now known as boscop
ssice has joined #ocaml
th5 has joined #ocaml
yezariaely has joined #ocaml
yezariaely has left #ocaml []
ssice has quit [Ping timeout: 265 seconds]
th5 has quit [Client Quit]
th5 has joined #ocaml
Julien_T has quit [Read error: Operation timed out]
mjonsson has quit [Remote host closed the connection]
_andre has quit [Quit: *puff*]
dark has quit [Ping timeout: 265 seconds]
avsm has joined #ocaml
munga has joined #ocaml
avsm has quit [Quit: Leaving.]
Yoric has quit [Ping timeout: 240 seconds]
Cybersoft has joined #ocaml
Yoric has joined #ocaml
<Cybersoft> how do I return a empty tuple of something in a match so that the case for [] is of the same type than the case el::list
<Cybersoft> I tried [] -> () but that's type unit and my second type return ('a * 'b * 'a)
<Cybersoft> so my question is how do I make [] return that type
<Cybersoft> while keeping it empty
z77z has joined #ocaml
<sdschulze> Cybersoft: ([] : ('a * 'b * 'a) list) ?
<sdschulze> [] must be of type: <something> list
<Cybersoft> [] is a list of 'a I'm adding stuff to it to obtain 'a * 'b * 'a in the 2nd match
<Cybersoft> and since I have to match the empty element of the initial 'a list the return type has to be a tuple too
<Cybersoft> if the end result was a list I know that [] -> [] would work, but the end result is a tuple and I don't know what's the equivalent
<sdschulze> Can you show us your code?
<Cybersoft> and apparently you can't decide to return nothing
<Cybersoft> and nothing is exactly what I need to return
<rossberg> Cybersoft: there is no "empty" value of type 'a * 'b * 'a
<rossberg> you probably want to use the option type
<Cybersoft> hum, I guess map would be a better choice
<sdschulze> Cybersoft: Can you show us your code? Maybe we can infer what you're trying to do.
<Cybersoft> sadly, I cannot
<sdschulze> just the relevant "match"
<Cybersoft> map will be a better choice because I convert a simple list of int to a complex list of (int * (something))
<sdschulze> OCaml isn't Python. Types must be known at run-time.
<Cybersoft> I don't want it to return a type, I want it to return nothing AND or break from the rec function when it encounter [] from the input list
<sdschulze> unless you're completely ignorant about them -- in which case you use type variables
<Cybersoft> I just want it to ignore the [] while not going in an endless loop
<sdschulze> You don't "break" in OCaml, either.
<Cybersoft> how do you convert a list to a tuple then if your tuple could be of any type?
<Cybersoft> you can't really convert the [] of any list to a tuple in that case
<sdschulze> You can't.
<Cybersoft> *in any case
<pozic> sdschulze: you can break if you want via monads.
<pozic> I have no idea how efficient they are in OCaml, though.
* pozic guesses they are not.
<sdschulze> Cybersoft: You can't convert a tuple of type 'a * 'b * 'a to a list.
<Cybersoft> if your input list and your output tuple has the some number of elements you can use map, but if they don't I guess your out of luck
<sdschulze> List elements must always have the same types.
<sdschulze> *type, that is
<sdschulze> "int list" is a list of ints. "(int * int) list" is a list of tuples of type "int * int".
<sdschulze> But unlike in Python, you can't do stuff like [1; "abc"; (2, 3)].
<sdschulze> I merely have a suspicion what your problem might be, but if you don't show us a portion of your code, we don't have a chance.
joewilliams is now known as joewilliams_away
init1 has joined #ocaml
<Cybersoft> ok, the reason I can't show my code is because it is marked homework. The question is also general because I may have a similar problem at the exam. And I'm not sure how I could make the question more general
<Cybersoft> the general question would be that I would have a graph with nodes and paths
<Cybersoft> and a list of nodes, and I need to output a list of tuples which each contrain a starting node and a list of nodes it can reach from the paths
<Cybersoft> *contain
<sdschulze> You know how variants work, right?
<Cybersoft> my problem is that the graph definition is in the form ([startnode, path_id, endnode],[...],lastnode) while the list of startnodes is of the form [node1,...]
z77z has left #ocaml []
<Cybersoft> and my end result has to be in the form [(startnode1,[endnode1, endnode2]);(startnod2,[endnode1]);...]
<Cybersoft> so my approach was to start from the list of startnodes and append the list of endnode for that node from a filter
<Cybersoft> so far so good, except when I get [] in the list of startnodes
<sdschulze> Appending [] does exactly nothing.
<Cybersoft> I match the list of startnode to get an element I can use in the filter
<Cybersoft> ok I guess I'll make some code from that general example
<Cybersoft> because it's really important for me
joewilliams_away is now known as joewilliams
<Cybersoft> so what paste site do you recommend?
<Cybersoft> pastebin? codepad?
<sdschulze> don't care
th5 has quit [Read error: Connection reset by peer]
<Cybersoft> map will not do either, because I need to know the value of the startnode in the nodelist. What I'd need is a modified version of map
<sdschulze> What should happen in the case of []?
th5 has joined #ocaml
<Cybersoft> that is my problem... the end result is a list of tuples and I'm building the endresult by making a list of tuple in the second match Ie: _::_ after the -> in the match
<Cybersoft> so what I'm doing is concatenating a bunch of tuples to form a list
<Cybersoft> so obviously the result of [] should be a tuple too (and it's the break condition of the recursion)
<Cybersoft> and that's my problem, I don't know what to do with the [] case... I wanted it to return an empty tuple as it shouldn't be added to the list of tuples I'm building... but I don't know how to do that
<sdschulze> So appending [] doesn't do what you want?
<Cybersoft> right, [] will take the type of all th other elements in the list, but what if the function is recursive ocaml doesn't see the other elements of a list the function don't see does it?
<Cybersoft> ok, it worked but when I run it it says Exception: Failure "tl".
<Cybersoft> the tl is used to remove the startnode I just processed from the graph
init1 has quit [Quit: Lost terminal]
<Cybersoft> ie: finalnodes(tl pathlist,lastnode) is recalled the rec function finalnodes with a recompositon of the original graph excluding the element I just processed
<Cybersoft> and apparently there is an exception generated there
_unK has joined #ocaml
<Cybersoft> yeah it's a tuple of lists, kinda obvious that wouldn't work...
ssice has joined #ocaml
init1 has joined #ocaml
<sdschulze> Failure "tl" signals that pathlist is empty when it shouldn't be.
<sdschulze> (in l. 15)
<Cybersoft> yeah, the graph is of type (list*int)
<Cybersoft> so if I do tl it remove the list - that's why it fails
<Cybersoft> what I need to do is extract the list and do a tl in it then put it back into a (list*int)
<sdschulze> That's certainly not what it's doing.
<sdschulze> confusing "tl" and "snd"?
<sdschulze> Type (list*int) doesn't exist.
<Cybersoft> ('a list*int) then ;)
<Cybersoft> I thought by doing ((pathlist, lastnode) : graph) and finalnodes(tl pathlist,lastnode) that it was exactly what I was doing
<sdschulze> Why 'a? Because the payload of the graph is polymorphic?
<sdschulze> pathlist can't be type ('a list*int).
<Cybersoft> ie: I extract the 'a list and put it in pathlist and the int is put in lastnode, then at the end I recompose the type graph by returning a tuple (pathlist - element I just processed ie: 'a list, int) -> 'a list * int
* sdschulze is confused.
<Cybersoft> I guess I'll put up a more complete program
chavaone has joined #ocaml
<Cybersoft> yes 'a is a definition of a path, a graph is a list of paths * id_of_last_path
chavaone has left #ocaml []
<Cybersoft> that's why I said 'a list * int ie: ([(1, "a", 2);(1, "b", 3);(2, "c", 3);(2, "a" 1);[3, "b", 1];(3, "c", 2),3)
<Cybersoft> and that's why I split it by using ((pathlist, lastnode) : graph)
ssice has quit [Quit: ssice]
<Cybersoft> because the pathlist will be [(1, "a", 2);(1, "b", 3);(2, "c", 3);(2, "a" 1);(3, "b", 1);(3, "c", 2)]
<Cybersoft> and the lastnode will be 3
<Cybersoft> that way I can easily extrat that 1 goes to 2 and 1 goes to 3 using filter that need a function and a list
<Cybersoft> but went I recursively call the function I need to recompose pathlist, lastnode so that it will get a graph
jakedouglas has joined #ocaml
<Cybersoft> that's why I was using tl to get ([(2, "c", 3);(2, "a" 1);(3, "b", 1);(3, "c", 2)],3) in the 2nd call
<Cybersoft> and ([(3, "b", 1);(3, "c", 2)],3) in the last one
<Cybersoft> and hence why I'm not sure tl isn't working... it's just taking a list and removing an element
<sdschulze> It doesn't work whenever you apply it on an empty list.
<Cybersoft> yeah, but it's not supposed to be getting an empty list
<Cybersoft> [(1, "a", 2);(1, "b", 3);(2, "c", 3);(2, "a" 1);(3, "b", 1);(3, "c", 2)] isn't an empty list
<sdschulze> But you're doing it recursively.
<sdschulze> So some time, it must be empty.
<sdschulze> And apparently your "match" isn't catching that properly.
<sdschulze> i.e. your "nodelist" function doesn't return an empty list, as it should
<Cybersoft> I think it's obvious at this point that I don't know how to solve that
<Cybersoft> the problem is the return type and the fact that I have to kinda recursively look up the endnodes
<Cybersoft> even with a tl it wouldn't work - because tl will remove the first one, not all the paths that start with 1
<sdschulze> Types shouldn't be a problem.
<sdschulze> If necessary, use variants.
<Cybersoft> they are for me, I'm not use to ocaml much
<Cybersoft> so for me taking a pathlist*lastnode and return a (startnode*startnode list)list is a bit difficult
<Cybersoft> so I have to both do a tl on nodelist so it will be eventually empty
<Cybersoft> and do the same on pathlist to remove all paths that start with the startnode I just processed
<sdschulze> If it helps, implement the algorithm in a language that you know better first.
<sdschulze> Then, if you got the algorithm right, translate it into OCaml.
<Cybersoft> and we haven't heard about variants in class so I can't use it
<Cybersoft> my problem has never been the algorithm, my problem is returning the right type
<Cybersoft> the problem is at the translate the algorithm to ocaml level
<Cybersoft> and I tried both map and rec both with a filter and it just never completly works
<Cybersoft> there's always an issue
<Cybersoft> ok, on another subject.... fold_right and fold_left.... they are meant to return something that might not necessarily be a list right?
<Cybersoft> map applies a function to each element of a list and return a list with the some number of elements with a function applied to them
<Cybersoft> but fold_right fold_right can return a list of anysize, or a value, or tuples depending on the function I apply right?
<Cybersoft> (my original problem is solved because there was an helper function I was supposed to implement before the one I talked about)
Julien_T has joined #ocaml
<Cybersoft> anyway I'll take a break, thanks a lot sdschulze for your help
th5 has quit [Quit: th5]
ftrvxmtrx has quit [Quit: Leaving]
pozic has quit [Remote host closed the connection]
Yoric has quit [Quit: Yoric]
ygrek has joined #ocaml
<Cybersoft> I think I'll name the helper function let Ihatethiscourse
sepp2k has quit [Remote host closed the connection]
iago has joined #ocaml
Cybersoft has quit []
avsm has joined #ocaml
ulfdoz has joined #ocaml
munga has quit [Read error: Operation timed out]
ssice has joined #ocaml
ssice has quit [Client Quit]
heller_ is now known as don_juan
don_juan is now known as heller
init1 has quit [Quit: Quitte]
npouillard has quit [Quit: leaving]
mjuad has joined #ocaml
avsm has quit [Quit: Leaving.]
Yoric has joined #ocaml
lpereira has joined #ocaml
<hcarty> Has anyone here used ocamlbuild 3.12's ocamlfind support + threads?
diml has quit [Ping timeout: 264 seconds]
Asmadeus has quit [Ping timeout: 276 seconds]
diml has joined #ocaml
ulfdoz_ has joined #ocaml
ulfdoz has quit [Read error: Operation timed out]
ulfdoz_ is now known as ulfdoz
Asmadeus has joined #ocaml
wuj has quit [Ping timeout: 265 seconds]
drunK has joined #ocaml
_unK has quit [Read error: Operation timed out]
ssice has joined #ocaml
sslice has joined #ocaml
<adrien> hcarty: something with threads in particular?
Edward_ has joined #ocaml
<hcarty> adrien: Yes - ocamlbuild doesn't seem to use the
<hcarty> "-thread" paramter with ocamlfind
<hcarty> When linking with the threads package
<hcarty> I submitted a bug in Mantis, but I'm wondering if I missed something
<hcarty> adrien: I ran in to the problem when using Batteries + ocamlbuild 3.12 + ocamlfind
<hcarty> Since the Batteries module requires threads
<adrien> seems to be working here
<adrien> hcarty: you used -classic-display to get the command-line?
ccasin has joined #ocaml
ccasin has quit [Ping timeout: 264 seconds]
sslice has quit [Ping timeout: 272 seconds]
ssice has quit [Ping timeout: 250 seconds]
ssice has joined #ocaml
ccasin has joined #ocaml
<hcarty> adrien: It showed the failing command line
<hcarty> adrien: Could you try generating an interface with ocamlbuild + ocamlfind + batteries?
ssice has left #ocaml []
<hcarty> I used: ocamlbuild -use-ocamlfind -pkg threads -pkg batteries foo.inferred.mli
ikaros has joined #ocaml
<hcarty> I get the same "Missing -thread or -vmthread switch" with foo.byte or foo.native
adrien_mib has joined #ocaml
Asmadeus has quit [Ping timeout: 265 seconds]
Asmadeus has joined #ocaml
ccasin has quit [Ping timeout: 264 seconds]
<adrien> hcarty: I used a _tags with "thread"
<hcarty> adrien: Would you mind putting up your _tags in a pastebin?
<adrien> passing '-pkg thread' isn't enough here either but was it before?
<adrien> hcarty: <*>: thread
<hcarty> adrien: That's odd ... '-tag thread' doesn't work
<adrien> btw, I think -tag* arguments don't work
<adrien> looks like you noticed too :P
<hcarty> :-)
<hcarty> Wow, still no luck
<hcarty> _tags: <*>: thread
<hcarty> foo.ml: open Batteries let () = print_endline "Hello world"
<adrien> or at least they don't work exactly like a _tags, I've been unable to get to include <*/**> but now I've switched to _tags and the whole build "process" (I had a shell script to drive everything) is much cleaner
<hcarty> Compilation line: ocamlbuild -use-ocamlfind -pkg threads -pkg batteries foo.native
ftrvxmtrx has joined #ocaml
<hcarty> adrien: I have been using a custom myocamlbuild.ml, modified from the Batteries example
<hcarty> I was hoping to eliminate the need for a myocamlbuild.ml for simpler projects
<adrien_mib> hcarty: my bad, I hadn't tried the whole combination and I also have the problem
<adrien_mib> without -pkg threads, -thread is passed to ocamlfind
<adrien_mib> but with, -thread isn't
<hcarty> That... is odd
<adrien_mib> hcarty: yeah, I think it's a bug
<adrien_mib> flag ["ocaml"; "compile"; "thread"] (A "-thread");;nif not !Options.use_ocamlfind then begin
<adrien_mib> (* lines for without ocamlfind *)
<adrien_mib> flag ["ocaml"; "link"; "thread"; "byte"; "program"] (S[A "threads.cma"; A "-thread"])nend;;
<adrien_mib> -thread is only missing at link-time here
seanstickle has joined #ocaml
<adrien_mib> it's from ocaml/ocamlbuild/ocaml_specific.ml, around line 535
<adrien_mib> btw, the forge is probably down for at least some people
<hcarty> adrien_mib: Thank you - would you mind updating the Mantis report with this information?
<adrien_mib> (and it's not a server crash but a problem with one of the hosting company's router)
<julm> adrien_mib: OVH ? :D
adrien_mib has quit [Ping timeout: 265 seconds]
<julm> TCPoverDNS failure :D
<adrien> julm: how did you guess? =)
<adrien> things seems good now
<julm> adrien: you were @gateway/web/freenode/ :P
Yoric has quit [Ping timeout: 276 seconds]
<adrien> oh, damn, irhgt, not mibbit :P
Yoric has joined #ocaml
sslice has joined #ocaml
sslice has quit [Ping timeout: 240 seconds]
npouilla1d has joined #ocaml
npouilla1d has quit [Client Quit]
npouilla1d has joined #ocaml
seanstickle has quit [Quit: lente lente currite noctis equi]
ccasin has joined #ocaml
Julien_T has quit [Ping timeout: 265 seconds]
ygrek has quit [Ping timeout: 245 seconds]
<adrien> hcarty: did you mention what I said about link-time vs. compile-time in the mantis bug report ?
lpereira has quit [Quit: Leaving.]
ulfdoz has quit [Ping timeout: 276 seconds]
Yoric has quit [Quit: Yoric]
ccasin has quit [Quit: Leaving]
seanstickle has joined #ocaml
Edward_ has quit []
seanstickle has quit [Remote host closed the connection]
seanstickle has joined #ocaml
seanstickle_ has joined #ocaml
seanstickle_ has left #ocaml []
seanstickle has quit [Ping timeout: 252 seconds]
ikaros has quit [Quit: Leave the magic to Houdini]
wuj has joined #ocaml
drunK has quit [Remote host closed the connection]