<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)]
<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)?
<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 :)
<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!
<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
<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
<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
<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 ?