hcarty changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | 3.11.1 out now! Get yours from http://caml.inria.fr/ocaml/release.html
kaustuv_ has joined #ocaml
boringwall has joined #ocaml
<boringwall> I need to write a function that takes in a function and a binary tree and maps each node in the tree to the function
<boringwall> Can someone provide some starting suggestions?
kaustuv has quit [Read error: 110 (Connection timed out)]
<orbitz> do you know how to make a binary tree? do you know how to iterate a binary tree?
<boringwall> I need to return a binary tree of the mapped values
<boringwall> That's my current issue
<orbitz> so you know how to do what I just asked?
ulfdoz_ has joined #ocaml
<boringwall> Yes
<orbitz> so what exactly is the part you are having trouble wiht?
<orbitz> when iterating, apply the function to the element, then put it back in and continue
<boringwall> Putting it back in is what I'm having trouble with
ulfdoz has quit [Read error: 60 (Operation timed out)]
ulfdoz_ is now known as ulfdoz
<orbitz> Node (update f leftNode) (update f rightNode)
<orbitz> do you have some simple code showing what you ahve accomplished so far?
<boringwall> Yes, one second
<boringwall> Testing it for all right nodes at the moment
<orbitz> Node (left, right) -> Node (mapetree f left, maptree f right)
<boringwall> Ah, I see
<boringwall> That makes sense
<boringwall> Thanks
Smerdyakov has quit ["Leaving"]
komar_ has joined #ocaml
slash_ has quit [Client Quit]
caligula__ has joined #ocaml
caligula_ has quit [Read error: 110 (Connection timed out)]
<boringwall> How can I restrict the nodes of a binary tree to a certain type?
<boringwall> e.g. define them so the tree can only have integer or floating point nodes
<orbitz> set the type in teh function
<orbitz> how have you currently implemetned your binary tree? replace the generic type placeholding iwht a concrete type
<boringwall> I've currently implemented it as generic (type 'a tree = LEAF of 'a | NODE of 'a tree * 'a tree). What I need is LEAF to be one of a few select types
tmaedaZ is now known as tmaeda0
<boringwall> How would I make that concrete type one of serveral other types?
<orbitz> so change 'a to a concrete type
<orbitz> maek another ADT that supports all the types you wantot support
<orbitz> why are you trying to limit the types of your tree thouhg?
<boringwall> It's an exercise from an Ocaml textbook
<boringwall> I've started with [Oca]ml a few days ago
<orbitz> k
<boringwall> type custom = {s: string; i:int; f:float};;
<boringwall> type tree = LEAF of custom | NODE of tree * tree
<boringwall> I'm assuming this is getting close?
<orbitz> that isa record, not an ADT
<orbitz> do you want all 3 of those, or just one?
<boringwall> Just one
<orbitz> then you don't wan ta record
<thelema_> type custom = String of string | Int of int | Float of float
<thelema_> type 'a tree = Leaf of 'a | Node of 'a tree * 'a tree
<thelema_> type custom_tree = custom tree
thelema_ is now known as thelema
<thelema> also, usually binary trees have data in the interior nodes, so
<thelema> type 'a tree = Leaf of 'a | Node of 'a tree * 'a * 'a tree
<orbitz> thelema: what aout somethign like: let string_tree (first_elm : string) = Leaf first_elm ?
<thelema> works, but doesn't allow strings, ints and floats in the same tree
<orbitz> oh true ture, i was thinking he was constraingint what 'a could be, not trying ot get all 3 posibilites
<boringwall> hmm
<boringwall> What if I wanted to make each node hold a list of these types?
<boringwall> Is that possible?
thelema_ has joined #ocaml
<orbitz> type custom_list_tree = (custom list) tree
<boringwall> (custom list) will actually make Ocaml interpret it as a list of custom types?
<orbitz> well look at:
<orbitz> # ["hi"];;
<orbitz> - : string list = ["hi"]
<orbitz> that has type "string list"
<orbitz> so if you want custom, then it woudl be type "custom list"
<boringwall> heh, didn't know it was that easy
<boringwall> Still very unfamiliar with the language :-O
<orbitz> you'll pick it up in time
<orbitz> what langauges have you used before?
<boringwall> C/C++/x86 ASM
<boringwall> Nothing functional
<orbitz> ah
<orbitz> you sohuld get used to the REPL then, probably haven't experienced tha tbefore
<orbitz> it's very handy
tmaeda0 is now known as tmaeda
thelema has quit [Read error: 110 (Connection timed out)]
verte has joined #ocaml
julm_ has joined #ocaml
* palomer has barely ever used the repl
<palomer> well, looks like harrop got the last word in the multi core debate
<orbitz> palomer: :)
<orbitz> palomer: i find it hard to disagree with him that the majority of Ocaml developers care about Coq
<palomer> but it's the WAY you say things
julm has quit [Read error: 110 (Connection timed out)]
<orbitz> yeah harrop certainly has his way of saying things
<kaustuv_> harrop's one tone objection to ocaml is just idiotic. yes, we get it, ocaml sucks for floating point.
boringwall__ has joined #ocaml
Yoric[DT] has joined #ocaml
mlh_ has quit [Remote closed the connection]
onigiri has quit []
boringwall has quit [Read error: 110 (Connection timed out)]
peddie has quit [Read error: 110 (Connection timed out)]
f[x] has joined #ocaml
mishok13 has joined #ocaml
boringwall__ has quit [Client Quit]
boringwall has joined #ocaml
_zack has joined #ocaml
Yoric[DT] has quit ["Ex-Chat"]
ttamttam has joined #ocaml
spaceBARbarian has joined #ocaml
verte has quit ["~~~ Crash in JIT!"]
<spaceBARbarian> can someone direct me to a good linux based IDE for ocaml
mlh has joined #ocaml
<det> ocalde
komar_ has quit [Read error: 110 (Connection timed out)]
<det> OcaIDE, I mean
<spaceBARbarian> gonna try camelia, im not that familiar with eclipse
<det> Well, I have had good experiences with OcaIDE
<det> I strongly suggest you try it out
<det> (I had never used Eclipse prior)
<myst> spaceBARbarian, best Linux IDE for whatever language is GNU Emacs. It's so good that I even use it on Windows.
<det> I disagree
<myst> your right
<det> Try out MonoDevelop or MS Visual Studio and experience the strong integration those IDEs have with their respective languages
<myst> and that only makes it impossible to use 'em for other things
<spaceBARbarian> oh boy, did i start something here ?
<det> spaceBARbarian, nahh
spaceBARbarian has quit [Remote closed the connection]
<det> myst, jack of all trades, master of none ? :-)
<myst> det, master of all, because it have Elisp I can make it master in whatever *I* want, and master with big M
<det> and besides, eclipse is obviously flexible enough to make OcaIDE
<myst> and Emacs too ;)
<myst> and vice versa
<myst> xD
<det> Emacs is terrible for GUI
<myst> erm
<myst> sorry?
<myst> what's so terrible?
<myst> I have not fancy icons?
<myst> It*
<det> I shouldnt have said that, I dont have time to support it now, I have to get to sleep
<det> gnight :-)
<myst> okay =)
<myst> gn
myst has quit []
myst has joined #ocaml
komar_ has joined #ocaml
_zack has quit ["Leaving."]
_zack has joined #ocaml
boringwall has quit [Read error: 104 (Connection reset by peer)]
verte has joined #ocaml
verte has quit [Client Quit]
verte has joined #ocaml
tonyIII has quit [Read error: 60 (Operation timed out)]
tonyIII has joined #ocaml
f[x] has quit [Read error: 110 (Connection timed out)]
mihamina has joined #ocaml
rwmjones_ has joined #ocaml
rwmjones_ is now known as rwmjones_lptp
kaustuv has joined #ocaml
kaustuv_ has quit [Nick collision from services.]
f[x] has joined #ocaml
mishok13 has quit [Remote closed the connection]
f[x] has quit [Read error: 60 (Operation timed out)]
ikaros_ has joined #ocaml
ikaros_ is now known as ikaros
Alpounet has joined #ocaml
kaustuv has quit ["ERC Version 5.3 (IRC client for Emacs)"]
rwmjones_lptp has quit ["Closed connection"]
bohanlon has quit []
<_zack> is Adrian Nader on this channel? (if anybody knows ...) I'm looking for info on the ocaml-gir project
mishok13 has joined #ocaml
ikaros has quit [Read error: 110 (Connection timed out)]
Submarine has joined #ocaml
Submarine has quit [Client Quit]
<gildor> _zack: not right now, but he used to be
<gildor> ask for Camarade_Tux
<_zack> gildor: tnx, I was just missing the mapping realname <-> nick name :)
<mihamina> how would you create a random string from a set a chars? (ie: a random string taken from "MdSrBgU" and only from those)
<mihamina> its in order to generate a friendly password, I will have to take one random vowel, and one random consonne
f[x] has joined #ocaml
<flux> well, there's the proper efficient way, and there's the easy way
<flux> the easy way would be something like: let gen_pass () = let chars = "MdSrBgU" in String.concat "" (Array.to_list (Array.init 10 (fun _ -> String.make 1 chars.[Random.int (String.length chars)])))
<flux> I hope batteries provides something nicer :)
<Alpounet> if not, you could propose it
<Alpounet> :-)
tmaeda is now known as tmaedaZ
<rwmjones> anyone using xpath from ocaml programs (either Alaine's XPath module or any other I should be looking at)?
<rwmjones> http://alain.frisch.fr/soft.html#xpath is the one I'm playing with now ...
<mihamina> flux: thank you
<flux> actually I think something like this could work in batteries (not tried): String.concat "" (List.of_enum (Enum.map (fun _ -> String.make etc..) (1 --- 10))) but it's still not a lot better
<flux> maybe if String.concat was changed to work on enums instead of lists :-), but that'd be a big breaking change
<flux> but on the other hand it would be nice if everything that doesn't _require_ datastructure Z would work on Enum.t
<flux> but then again it might require more casting.. maybe a literal syntax for enum lists would help?
f[x] has quit [Read error: 145 (Connection timed out)]
<Alpounet> I'm pretty sure we can do much clearer with comprehension
<thelema_> String.of_enum (foo)
<thelema_> let foo chars = let n = String.length chars in Random.enum_int n |> Enum.map (fun i -> chars.[i])
<thelema_> |> Enum.take 8
* Alpounet misses mlbot so much
<flux> thelema_, Enum.map (String.get chars) ?
<flux> I guess it's about as long, though :)
<flux> in any case, it's better than the original
<Alpounet> if I find some time, I'll try to add some additional monadic stuffs
Alpounet has quit [Remote closed the connection]
Alpounet has joined #ocaml
_andre has joined #ocaml
komar_ has quit [Read error: 110 (Connection timed out)]
<Alpounet> anyone here can remember me how I can clone a git repository on ocamlcore but with the "developer" command ?
<Alpounet> to be able to push some changes, etc, I mean
<Alpounet> something like git clone git+ssh://forge.ocamlcore.org/project/<foo>/<foo>.git IIRC
<Alpounet> s/forge/git/
<Alpounet> s/project//
<Alpounet> hmm, I get 'fatal: '/batteries/batteries.git': unable to chdir or not a git archive
<Alpounet> fatal: The remote end hung up unexpectedly
<Alpounet> '
<Alpounet> with : $ git clone git+ssh://git.ocamlcore.org/batteries/batteries.git
ikaros has joined #ocaml
ski_ has joined #ocaml
<mihamina> how to cast an integer to a string? (not printing, really casting)
<flux> mihamina, that would likely result in a crash. why would you do that?
<flux> mihamina, if you want to do binary IO, there's a module around to do that..
<flux> maybe extlib/batteries has the functions
<mihamina> because I generate some numbers, serial numbers, sequentially, and would like to print them to a web page (cgi script)
<flux> um wouldn't you want human readable numbers?
<flux> in other words, you'd want to convert them to ascii?
<mihamina> human readable? they are 7 digits
<mihamina> I wil have to print 0000001, 0000002, .... 9999999 in a table
<mihamina> with the leading 0
<flux> well, number 1234567 is represented in memory as something like 0x00 0x87 0xd7 0x12
<mihamina> hum... not easy to get 00001 -> 99999 with the leading 0s then....? wow.... big problem :-)
<flux> _casting_ it to a string would result in string "\000\135x\018"
<flux> no, it's just we don't call it casting :)
<mihamina> aaaah
<mihamina> ok
<Alpounet> something like sprintf then ?
komar_ has joined #ocaml
<flux> yes. and you are in luck: Printf.sprintf is what you want :)
willb has joined #ocaml
<mihamina> let me give a try
<mihamina> Printf.sprintf "%4d" 5 ;; print 6 spaces...
<flux> %04d
<mihamina> how to get 6 zeros?
<flux> you mean %07d then?
<mihamina> flux: perfect.... i need to get used to read such documents: http://caml.inria.fr/pub/docs/manual-ocaml/libref/Printf.html
<mihamina> when not used, reading is a bit confused :-)
albacker has joined #ocaml
verte has quit ["~~~ Crash in JIT!"]
cognacc has joined #ocaml
<gildor> Alpounet: git clone git+ssh://git.ocamlcore.org/git/batteries/batteries.git
<Alpounet> thanks !
<myst> erm, while learning OCaml I found interesting inconsistence: Big_int.int_of_big_int vs. Int64.to_int. Why it's that? I understand that the modules was developed by different people, but this is plain ugly. :(
<myst> so now I need to remember functions in each modele. If they are named uniformly - it would be much easier to remember them all, no?
<flux> maybe the Big_int module has been designed to be "open"ed
<flux> or perhaps it has historical payload
<flux> although it doesn't provide any operators, so perhaps no :)
<flux> I suppose it would hardly break any code if it provided to_int/of_int also?
<flux> the naming convention of the module does indicate something like that, though
<flux> everything has big_int stuck to the name
<myst> I think that it's reasonable to follow Pervasives' convention <type1>_of_<type2>
<myst> anyway everyone start using OCaml from it
<flux> oh, ok
<flux> many modules that only cover one tyope have a function called to_someothertype/of_someothertype
<flux> and the from/to type is assumed to be understood from the module
<myst> indeed
<tiz> This has got me wondering - is there any performance loss from, say creating a new module that simply aliases another one with different function names?
<flux> pervasives' functions are a special case in the sense pervasives doesn't have a 'default type'
<tiz> That seems like it should optimise away at compile time.
<flux> tiz, I don't think not, atleast if you use ocamlopt
<flux> "I don't think so" :-)
<tiz> I hope not, but then I'm constantly surprised at the optimisations OCaml doesn't do. :)
<myst> than Big_int don't follow the rules ;)
<myst> then*
<flux> none of the numeric module appear to
<flux> so there's your rule ;)
<myst> it's not a big issue, but it's natural to formalize things before including them in core, isn't it? so I thought maybe there are any good reasons for it...
<flux> perhaps they come from caml light. no idea, though. also, no idea if batteries does anything on this. I think the numeric modules don't have many users..
<myst> by core I mean std lib =)
<myst> nobody needs integers bigger than 2^30?
<myst> huh, and this is when HDDs are bigger than terabyte... o_O
<myst> i am surprised
<flux> actually I meant the numeric modules that don't map to hardware
<tiz> I'm always surprised by the lack of Int31/Int63 modules. It seems odd that each word size gets a tyoe that is totally inaccessible on other architectures.
<flux> I've ued Int32/Int64 on occasion
<flux> tiz, what else would be changed then? I mean, who would use Int31 for anything?
<myst> are there 31-bit words somewhere?
<flux> well, I suppose someone would
<tiz> Int31 is less useful, admittedly. However, I frequently want ints larger than 2^31,
<tiz> Currently, my only option is Int64, which performs badly on both word sizes.
<tiz> Worst of both worlds.
<flux> myst, yes, in o'caml, on 32-bit platforms..
<flux> tiz, well, that's reasonable
<myst> I know, but we don't need a module for 'int'
<flux> tiz, perhaps you can write a module and submit it to the kind batteries folks ;)
<flux> myst, actually a module for Int can be useful when you functorize stuff
<tiz> flux: Yep, I'm considering it. :) I suspect that such a module can't be trivially implemented in OCaml though without some knowledhe of the compiler.
<tiz> Which I would love to have, but lack the time.
<flux> tiz, how come?
<flux> tiz, I think it would be basically copy/paste from Int64
<flux> actually Int64 is probably implemented in C in parts
<flux> so maybe not
<flux> but in any case, the module should be pretty simple as far as I can see :-o. the only magic is that on 64-bit platforms it would use 'int' as the backing type and on 32-bit platforms it would use Int64.t
<flux> _however_, that could make certain code work differently
<flux> for example if you use finalizers, ==, ..
mihamina has quit ["Leaving."]
<tiz> I assume that the compiler needs to "know" about such a module because it needs to do something slightly different on each architecture. (But I'll admit that my knowledge of these things is limited enough that I might be assuming it's hard when it's not.)
<myst> flux, okay, I decided that this naming inconsistecy is result of Big_int is supposed to be opened, whlie Int__ aren't ;)
<flux> myst, great, now you don't have to lose your sleep over it :)
<myst> just looked at Batteries, holy sh*t! such a bloat. I never will use it.
<flux> :)
<flux> anything in particular?
<myst> flux, that's it, exactly
<flux> how do you feel about extlib?
<flux> or the libraries batteries uses
<myst> after coming to OCaml from Haskell I feel bad about Monads
<myst> what's the point?! o_O
<flux> monads can be useful at times
<myst> I wanted practical PL, not academic one
<flux> for example Lwt. I've used them for database access too. makes sure you don't have a too direct handle accessible.
<myst> erm?
<flux> actually what would replace monads for me would be a linear type system, but I don't think we're going to see that any time soon in ocaml :)
<myst> what's wrong with handle := XXXopen(...)
<myst> ?
<flux> well. I've got functions that have return value 'a db_action, and the contents might be for example: let list_foo = transaction(select "* from a" >>= fun a's -> select "*" from b" >>= fun b's -> return (a's, b's))
<flux> and I can embed that to other transactions, because transactions within transactions magically convert into savepoints
<flux> and I happen to think it's pretty convenient :)
<flux> and you can run that transaction with run db_handle list_foo (of course, you could use parameters also)
<myst> erm... I don't get it
<myst> maybe later ;)
* myst always thought: if smth isn't as obvious as + or - than it's bad.
<myst> otoh it depends on background...
<myst> whatever!
<flux> well, I don't mind, people use what's best for them :)
<myst> sure
<flux> infact, I just recently used mutation where fold_left would've done!
<flux> I wrote a little piece of software that guesses how you want to rename your files: http://modeemi.cs.tut.fi/~flux/software/ganame/
<myst> you make me sick ;-)
<myst> oh GA
<myst> wrote a project using them in 3rd year in university
<myst> pretty interesting thing btw
<myst> and simple one xD
<Alpounet> myst, there isn't any monads in the released versions of batteries
<flux> I never did anything with it, but recently (the beginning of) the book Essentials of Metaheuristics which made me to try it out
<Alpounet> only in my branch
<flux> (in practice I don't think I'll find many uses for GA)
<myst> Alpounet, I am n00b, don't listen what I say xD
<myst> flux, every non-trivial positioning or sorting problem can be soved using GA
<_andre> flux: i've used a GA to optimize virtual host allocation in our webservers, it worked pretty well :)
<myst> providing you know how to eval genes
<tiz> *Every* one?
<tiz> Doesn't the No Free Lunch theorem say otherwise?
<flux> tiz, it depends what you mean by solving of course ;)
<myst> okay, many of them
<flux> tiz, because if you have multiple 'good enough' solutions, you might never find the optimal one
<flux> tiz, but it's better than having no solution at all..
<myst> sometimes "good enough" is good enough, look at UNIX ;)
<myst> nobody bother to try Plan9 (which is waaay better) because UNIX is good enough
<flux> does it have firefox? yeah, though so ;-)
<flux> actually these days with the coming of virtual machines it should not be that big a task to try out fun os'es
<flux> so perhaps some smaller os'es get new developers that way
<flux> well, I still haven't tried Hurd out.. ;)
<myst> Hurd will never be finished
<flux> will linux?-)
<tiz> Has mankind ever "finished" an OS?
<orbitz> tiz: well i think first in order to undersatnd that we must understand the words that make up "mankind". "mank" and "ind", the meaning of whih we may never know
<thelema_> tiz: what has mankind really "finished"?
<flux> the great wall of china?
<thelema_> flux: left incomplete
<flux> damn
<flux> well the wall in germany then?-)
<thelema_> maybe some buildings are "complete"
<orbitz> depends on "complete", every structure is battling entropy and needs maintenance
<thelema_> software projects never really seem to complete, though.
<myst> by finishing Hurd I mean making it work already
<thelema_> except maybe TeX
<flux> and mankind has landed on the moon, so I think that's finished in some sense
<orbitz> i cona't think of anything where you say "okay, i can finish touchign this"
<thelema_> flux: we're going back for more.
<myst> there are two kinds of people: of result (Linux) and of process (Hurd)
<flux> thelema_, but the previous landing was finished; )
<flux> hmph, this is the third time I've heated the water for my tee, this time I'll surely remember to brew it..
<thelema_> k
<thelema_> k
<myst> btw, to use imperative assignment I should use ref, right?
<thelema_> yes
jonafan_ is now known as jonafan
f[x] has joined #ocaml
julm_ is now known as julm
Submarine has joined #ocaml
tmaedaZ is now known as tmaeda
onigiri has joined #ocaml
ttamttam has quit ["Leaving."]
bzzbzz has joined #ocaml
Submarine has quit [Read error: 110 (Connection timed out)]
tmaeda is now known as tmaedaZ
_zack has quit ["Leaving."]
spaceBARbarian has joined #ocaml
<spaceBARbarian> is there a way to enable history with the 'ocaml' prompt ?
<flux> spacebarbarian, use rlwrap or ledit
<thelema_> hmm, could the compiler be patched to detect either of those, and auto re-run itself under it?
<flux> you mean toplevel?
<thelema_> yes
<flux> perhaps, but there would need to be some conditions
<flux> like, only if both stdin and stdout are tty
<flux> but I suppose in that case..
<thelema_> of course.
<spaceBARbarian> flux>> how exactly do i run toplevel with ledit, ive never used that prog before
<flux> spacebarbarian, install one of them, and run for example: rlwrap ocaml
<spaceBARbarian> cool got it, thanks
<thelema_> (and it could give a warning each time it doesn't find one, disablable to not bother those really wanting the warning, but pointing new users in the right direction if they don't have it._
<thelema_> "line editing disabled - install rlwrap or ledit"
* thelema_ doesn't know why ocaml just doesn't come with ledit
<thelema_> I can understand the problem with integrating readline.
<spaceBARbarian> awesome this is sooo much nicer
<thelema_> yes, we're all spoiled here in the 21st century. Ocaml's interface is still stuck in the '80s.
<thelema_> when you were happy to have backspace
<thelema_> !! doskey !!
<spaceBARbarian> is the star in this result "val f : 'a * 'a list -> 'a list" a pair ?
<thelema_> yes
mihamina has joined #ocaml
<mihamina> hi all
<mihamina> (re)
<thelema_> hi
thelema_ is now known as thelema
<mihamina> I have a bunch of strings, where the 3 firsts chars are letters the reste are numbers (ie HPT0001 -> HPT4567), I would like to extract the last, because i hae to go on the numeration
<mihamina> so, the first 3 chars, not a problem
<mihamina> but then how to transform to integer the string "4567" ?
<spaceBARbarian> what type of function would give this result: ('a -> 'b) * ('c -> 'a) -> 'c -> 'b , i dont get the meaning of using 'b 'c instead of just 'a
<flux> thelema, there's a bsd clone of readline.. libedit, perhaps. they could use that.
<mihamina> # int_of_string "223";;
<mihamina> - : int = 223
<flux> spacebarbarian, let f (a, b) c = a (b c)
<spaceBARbarian> right i understand what it does, just want to know why ocaml interprets it with the 'a 'b 'c stuff
<flux> spacebarbarian, so you want to know why it isn't ('a -> a) * ('a -> 'a) -> 'a -> 'a ?
<spaceBARbarian> yes :)
<flux> spacebarbarian, well, consider this: f string_of_int int_of_float
<flux> whops
<flux> f (string_of_int, int_of_float)
<flux> neither string_of_int nor int_of_float matches 'a -> 'a
<spaceBARbarian> oh so it can be 3 arbitrary types ?
<flux> yes
<spaceBARbarian> * 3 different types
<thelema> arbitrary types.
<thelema> can be different, can be some same, can be all same.
<flux> the type variables define how the types relate to each other
<flux> so 'a isn't just a wildcard: all 'a 's must be the same type
<flux> (_ works as a wildcard in types too, btw)
<spaceBARbarian> yeah makes sense
Alpounet has quit [Remote closed the connection]
Submarine has joined #ocaml
tvn has joined #ocaml
<tvn> is it possible to just output the exception (e.g., the name of the exception) so I know what exception was raised ? for example try (.... lots of code) with e -> ( printf "%s" e) ?
<flux> tvn, look at the Printexc-module
<flux> tvn, if you're on 3.11, you can do better: print the backtrace
<tvn> thanks flux
<tvn> I don't have ocaml 3.11 though
<flux> tvn, in that case, you might consider just letting the exception fall through
<flux> tvn, if you've compiler with -g, you can then export OCAMLRUNPARAM=b and still get the backtrace
<tvn> ah ic
<flux> but I suppose that's not suitable for you, as that way you would've seen the exception name anyway..
Alpounet has joined #ocaml
<tvn> I just use printf "%s" (Printexc.to_string e) ; and it does what I need
<tvn> print out the name of the exception
<spaceBARbarian> is there any difference between let f (g, h) = function x -> g (h x);; , and let f g h = function x -> g (h x);;
<spaceBARbarian> other than the fact that one uses currying and the other does not, i.e. difference other than just how they take the parameters g and h
<thelema> currying is the process of converting the first into the second.
<thelema> there's not much difference between the two otherwise.
ttamttam has joined #ocaml
<thelema> currying = un-tuple-ifying
<flux> spacebarbarian, in ocaml we traditionally use the curried form (for example SML would usually prefer the tuple form), unless there is some reason to do otherwise
<spaceBARbarian> okay, cool so the only difference is in the language implementation, nothing functionally
<flux> I think tupled form can be less efficient also, because the tuple needs to constructed..
<thelema> can be - depends on if you have the tuple already handy (for example as output of another function)
Amorphous has quit [Read error: 110 (Connection timed out)]
Amorphous has joined #ocaml
<spaceBARbarian> how come this is interpreted as a multiplication and not a pair of x and 2 ... (x * 2)
<thelema> , creates pair values
<thelema> * is multiplication
<thelema> in types, you have * for pairs, and , for multiple type parameters
<thelema> type foo = (int , float * string) Hashtbl.t
<thelema> is a hashtable that maps from (int) to pairs of (float, string)
<thelema> pairs are cartesian products of other types.
animist has quit [Remote closed the connection]
<spaceBARbarian> yeah i was just getting confused with actual syntax and the results from the interpreter
<thelema> types use * in a different manner than values.
<spaceBARbarian> can you explain why ocaml allows two different aribtrary types here : http://pastebin.org/28438
<spaceBARbarian> when i actually use two arbitrary types it throws an error
<thelema> what error?
<thelema> it's correct that it uses 'a -> 'b
<myst> what bindings do you guys use to access PostgreSQL? postgresql-ocaml?
<flux> pastebin.org? is that some scam version of pastebin.com? because it juts gave me a popup
<spaceBARbarian> flux>> no .org is the real one
<thelema> I think they're the same.
<spaceBARbarian> thelema>> f is just int -> int, so i dont get why that 'a -> 'b is even there
<flux> well, perhaps they just had a bad batch of ads then
<flux> although it says 'ads by google'
<spaceBARbarian> thelema>> wait ignore that part aobut f
<thelema> flux: a clone website - one is skyseek.com, and has a feedback box, the other seems unbranded
<flux> btw, pastebin.com is created before pastebin.org (2002 vs 2004)
<spaceBARbarian> thelema>> so how could i change that parameter f, to make sure the type is just 'a
<thelema> 'a -> 'a?
<thelema> int -> int fits in 'a -> 'b
<thelema> int -> float doesn't fit in 'a -> 'a
<myst> thelema, use www.codepad.org and be happy
<spaceBARbarian> thelema>> yeah so how do i enforce that the function f, given as a parameter to maptree, is only of type 'a -> 'a
<flux> codepad is fun
<spaceBARbarian> yeah codepad is awesome
<flux> spacebarbarian, you can explicitly limit the type
<flux> let rec maptee (f : 'a -> 'a) x = ..
<flux> spacebarbarian, but why would you?
<flux> (in this case)
<thelema> yeah, what flux said.
<spaceBARbarian> cause my homework wants me to :P
<flux> :-)
<myst> so what about PostgreSQL? Anyone use it from OCaml?
<flux> sure
<myst> with what bindings?
<flux> there's two options. one are markus mottl's bindings, the other is PG'OCaml
* thelema hasn't done ocaml + DB
<flux> the latter is extremely neat, if you don't need dynamic SQL
<myst> aha, PG'OCaml is awful tbh
<flux> awful?-)
<myst> yup
<myst> awful syntax
<flux> it has very little syntax?
<flux> and then just SELECT away
<flux> and type system is happy
<flux> in any case, there's always the other bindings.
<flux> there's also macaque, but it's not mature yet
<myst> it has scary syntax, I've looked at it and it's like nothing I can understand. I want something like Python's DBAPI2, Perl's DBI or Haskell's HDBC
<myst> something plain and easy
<myst> ok, I've just found ocamldbi
<flux> ocamldbi seems deserted? where?
<thelema> heh, "bindings with perl libraries"
<flux> but, I don't think postgresql-ocaml has proper query construction :/
<flux> so basically you first do that and then start using it ;-)
<myst> I am comfortable with constructing queries by Printf.sprintf
<myst> this is what I basicaly want, withoun fancy syntax and hard-to-understand uber-features
<flux> which basically invites sql injections :/
<flux> of course, you can just Do It Properly, and never mistakenly put a user string inside a query directly
<myst> SQL injections is in the head of developer, not in bindings =)
<flux> or, you can have a system that makes it easier to write proper queries than improper
<myst> I better stuck with system which I can use however I want
<mihamina> hey...
<myst> and which have 6 functions, and no fancies =)
<flux> for example I've used foo "select * from bar where a = ?0 and b = ?1" [0, Db.str input1; 1, Db.int input2]
<flux> (and I don't need to worry about writing '?0' either)
<myst> autoquoting is cool, yes
<mihamina> i am looking for an example of generating a list recusively (list of increasing int, from a given int)
<spaceBARbarian> how can i print the type of a function f after it is declared ?
<myst> but not with that ugly let PGSQL(dbh) ...
<mihamina> something like: let generate_list begining number accumulator = (*...*)
<flux> mihamina, let rec generate_ints x0 x1 = if x0 > x1 then [] else x0::generate_ints (x0 + 1) x1
<flux> oh, well an accumulator is good too
<flux> do that and get some excercise ;-)
<mihamina> I am doing...
<mihamina> but no result
<flux> what've you got so far?
<mihamina> for ine hour and a half
<myst> try to thing
<myst> think*
<flux> myst, PGSQL(dbh) is what you have issues with? pfft :)
<myst> is *is* ugly
<myst> no wai I will use it )
<mihamina> let rec generate_ints current left acc = match left with
<mihamina> 0 -> acc;
<mihamina> | n -> generate_ints (current + 1) (n-1) ???????
<mihamina> I dont knwo what to do inthe ???? place
<mihamina> to concatenate
<flux> mihamina, generate_ints (current + 1) (n - 1) (n::accu)
<flux> mihamina, however, you might find another problem with your implementation.. but perhaps that helps you further
<mihamina> my onley problem is I am ashamed such a simple thing takes me hours to do :-)
slash_ has joined #ocaml
<flux> it will click to you, just wait :)
<flux> persistence, perspiration, etc
ttamttam has quit [Read error: 113 (No route to host)]
<mihamina> flux: the question on integers generation was just a simplified version of my problem... i am trying one thing
ttamttam has joined #ocaml
_zack has joined #ocaml
spaceBARbarian has quit ["Leaving"]
<thelema> hmm, I have a large recursive value that I need to create, and it's not mutable, so i don't see a way of creating it in pieces.
<thelema> it's basically a graph
<thelema> hmm, maybe I can create it a node at a time, although how can I create the first node...
<thelema> I guess I'll have to rewrite a large part of the graph as I add nodes.
<thelema> there's got to be a way to create it at once.
<thelema> in one pass
<Alpounet> isn't there a tail-recursive way to do it ?
<Alpounet> how do you have to create it ?
<thelema> I have the graph represented with integers as pointers
<thelema> i.e. (1,2) == edge from node 1 to node 2
<thelema> and I want to make a bunch of nodes that point at each other in the specified manner
<flux> thelema, maybe you can use laziness
<thelema> I think I'll have to build an array of nodes, so I can look up which node each integer points to...
<flux> thelema, like: let rec a = lazy (Lazy.force b) and b = lazy (Lazy.force a)
<thelema> but I can't create a node unless I know its edges
<thelema> flux: that's good for a fixed set of pointers, but I can't see how to do the equivalent for a larger mesh
<thelema> I guess I'm going to have to make the edge list mutable
<flux> thelema, with the array?
<thelema> so I can add edges to nodes without replacing that node (and thus requiring replacement of all nodes that point to it.
<thelema> step 1: create a bunch of nodes without edges
<thelema> step 2: add the required edges.
<flux> step 3: win?
<thelema> step 3: profit!
<Camarade_Tux> rwmjones: about GdkPixbufAnimation, ocaml-gir could help for that but it won't be ready before a few days
tvn has quit ["Leaving"]
sramsay has joined #ocaml
andre___ has joined #ocaml
<Camarade_Tux> I can't git push to ocamlcore, is it just me?
ttamttam has quit ["Leaving."]
<thelema> Camarade_Tux: it's probably related to the new vserver
<gildor> not active yet
<gildor> what is the problem ?
<thelema> hmm, git.ocamlcore.org works.
<Camarade_Tux> I can't push (waited for more than 15 minutes) but it could be on my hand
<gildor> you maybe have a DNS resolution problem
<Camarade_Tux> ok, I was downloading at <1KB/s, must be on my hand
<Camarade_Tux> s/hand/end/
<Camarade_Tux> dns works ok but the connection got crappier today I think
<gildor> there is no reason on the server side to download at this rate
<gildor> I am connected to the server right now, and have no problem
<Camarade_Tux> I was downloading from lip6.fr and considering the lag I get while typing this through ssh+screen, I'm not surprised it's slow but I thought git would _eventually_ succeed
<thelema> Camarade_Tux: I'll check pushing when I get to my laptop
<thelema> (or sooner)
<gildor> Camarade_Tux: does it mean that you think the bug is on your side ?
<Camarade_Tux> thelema: I should soon be able to use a wifi connection which should easily be faster
_andre has quit [Read error: 110 (Connection timed out)]
<Camarade_Tux> gildor: probably, I hadn't realized my connection was currently slower than a 56Kk
* thelema forgot the git+ssh url scheme for ocamlcore
<thelema> or maybe the problem was that my new public key hasn't percolated through cron
* thelema goes home so he can get the details off his laptop
kaustuv has joined #ocaml
<Alpounet> thelema, for your graph stuff, isn't there any way you could sort your pairs so that you could do a depth-first graph construction ?
<Alpounet> looks a bit brain-masturbating but ...
Demitar has quit ["Ex-Chat"]
f[x] has quit [Read error: 145 (Connection timed out)]
albacker has quit ["Leaving"]
<gildor> heads up, ssh for forge.ocamlcore.org has changed
<gildor> please test push/pull with svn/bzr/git/hg whatever
<gildor> I don't have errors for now
<Alpounet> gildor, we have to put back our ssh keys, on the web interface, right ?
<gildor> no
<gildor> everything is the same as before
<gildor> have you problem to connect ?
<thelema> it's a graph with links going every which way - I don't think I can order things that way. Every node will have plenty of outgoing links, unlike a tree where the leaves don't.
<thelema> gildor: bash: git-upload-pack: command not found
<thelema> connecting works (modulo deleting some host keys on my end)
<gildor> thelema: try agin
<gildor> I have installed the wrong git package
<thelema> looks good.
ski_ has quit ["Lost terminal"]
Yoric[DT] has joined #ocaml
<thelema> gildor: hmm...
<thelema> maybe the problem is on my end, but I just had a wierd error when pushing
<gildor> what is the problem ?
<thelema> unpacker error
<thelema> some problem (I don't know on which side) creating a temporary sha1 filename
* thelema is running git fsck on my side
<thelema> ok, now to run git fsck on ocamlcore
andre___ has quit ["leaving"]
<thelema> hmm, I think I'm having permissions problems
<gildor> ok
<gildor> could you give me more informations
<Alpounet> thelema, then I doubt you can do a one-pass construction :/
<thelema> as soon as I figure out what's going on, I'll let you know.
<thelema> excepting using mutability.
<thelema> mutability it is.
<Alpounet> gildor, actually yes, just gotta figure out if I've done something wrong.
<Alpounet> thelema, yeah, but thus you'd be forced to pass around your mutable nodes all around each call to your recursive function
<flux> thelema, I think there's a paper on manipulating immutable graphs..
<flux> thelema, iirc the haskell graph library is based on it
gawron has joined #ocaml
<thelema> Alpounet: pass around the mutable nodes? I know exactly how many of them there are - just make an array and start adding edges between nodes by using the array indices to find node_i
<Alpounet> thelema, an adjacency matrix, actually, isn't it ?
<gildor> thelema: i will reboot the server
<thelema> alp: more or less
<thelema> gildor: I doubt that'll help, but ok.
<gildor> this will flush some uid in cache
<gildor> but this won't help a lot
<thelema> ok. I'll try once it's back up
<gildor> it is already backup
<gildor> back up
<thelema> and I've failed again
<thelema> same error.
<gildor> can you give the precise error
<thelema> error: unable to create temporary sha1 filename ./objects/5b: File exists
<gildor> pwd ?
<thelema> fatal: failed to write object
<thelema> error: unpack failed: unpacker exited with error code
<thelema> pwd is almost certainly /gitroot/batteries/batteries.git
<thelema> I get this error on the client side when I try to push.
<thelema> There's a slight bit more, but that's the core.
<gildor> I think we have lost group for user
<gildor> will fix that
<gildor> # id thelema
<gildor> uid=20142(thelema) gid=20142(thelema) groupes=20142(thelema),10019(comm-ocaml),50019(scm_comm-ocaml),10017(batteries),50017(scm_batteries)
<gildor> and in the new ssh
<gildor> # id thelema
<gildor> uid=20142(thelema) gid=20142(thelema) groupes=20142(thelema)
<thelema> yup, I have no groups
<gildor> this is shorter ;-)
* thelema needs groups
<thelema> kaustuv: thank you for the link.
<gildor> thelema: fixed i think, could you try again
<gildor> thelema: could you try again
_zack has quit ["Leaving."]
Yoric[DT] has quit ["Ex-Chat"]
gawron has left #ocaml []
<thelema> gildor: fixed
<gildor> thelema: anything else ?
<gildor> thelema: you need something more than rsync/unison/vi ?
* Camarade_Tux finally has a better connection, git push seems to work (well, it complains about the key but that's it)
<Camarade_Tux> it's pretty weird, it seems my previous git push attempts had been successful
<gildor> Camarade_Tux: you don't have any problem with git push/pull ?
<Camarade_Tux> (although git push remained completely silent)
<gildor> you are using the new ssh host
<Camarade_Tux> gildor: yep, and works fine
<gildor> ok great
<Camarade_Tux> :)
<Camarade_Tux> and thanks again for the forge :)
<gildor> we are in the middle of a migration toward something better
<gildor> the forge will be even nicer in a short term future
<gildor> (integration of git/darcs/bzr directly in the forge)
<Camarade_Tux> I have to say I'm looking for this one, ocaml-gir looks like a completely dead project (0% activity) although I commit quite often ;p
<gildor> Camarade_Tux: most of my projects seem also dead (like ocaml-autobuild)
<gildor> FusionForge will provide stats for darcs and git and make you up in the activity percentile
<Camarade_Tux> nice :)
<Camarade_Tux> btw, the forge isn't currently running fusionforge, right?
<gildor> no, it is running an old GForge version
<Camarade_Tux> I just checked the history of the project, it's even weirder than I remembered ><
<gildor> which history ?
<gildor> have you some problems ?
<Camarade_Tux> no, I sf.net vs. gforge vs debian's fork vs fusionforge ( http://en.wikipedia.org/wiki/GForge which is full of "citation needed")
<gildor> oh yes
<gildor> forge history is a long and complicated path
<gildor> now, we are also working on https://forge.ocamlcore.org/projects/ocsforge/
<gildor> a forge using ocsigen
<gildor> ;-)
<gildor> and the history of the forge got longer
<Camarade_Tux> yeah, I remember seeing that in the project list ;)
<Camarade_Tux> could have some nice things :)
<gildor> ok, need to go to sleep
<gildor> if there is any bugs
<gildor> night
<Camarade_Tux> looks fine right now, and I don't think I'll use the forge much tonight, I should go to bed pretty soon too ;)
<Camarade_Tux> night :)
<Alpounet> gn people
sramsay has quit ["Leaving"]
cognacc has quit [Remote closed the connection]
smimou has quit ["bli"]
<thelema> # Q- Which animal does a Hippophobe fear?
<thelema> oops, bad paste
<thelema> gildor: don't need anything more, unless you can convince me that
<thelema> gildor: don't need anything more, unless you can convince me that # Q- Which animal does a Hippophobe fear?
<thelema> grrr...
<Camarade_Tux> ^^
Alpounet has quit ["Leaving"]
tmaedaZ is now known as tmaeda
tmaeda is now known as tmaedaZ