<Riastradh>
pattern, asking that is asking 'how is a tool to combine all the rag-tag sets of mini-languages used to control UNIX unified into one consistent OCaml library useful?'
<pattern>
well, i don't know anything about cash, so that's why i ask
<Riastradh>
Read Olin Shivers' original papers on scsh.
<pattern>
ok, thanks, riastradh
rox has quit [Read error: 104 (Connection reset by peer)]
rox has joined #ocaml
Nutssh has quit ["Client exiting"]
Nutssh has joined #ocaml
cjohnson has quit ["Drawn beyond the lines of reason"]
buggs^z is now known as buggs
buggs^z has joined #ocaml
buggs has quit [Read error: 60 (Operation timed out)]
Nutssh has quit ["Client exiting"]
buggs^z is now known as buggs
pattern has quit [Excess Flood]
pattern has joined #ocaml
gim has joined #ocaml
mimosa has joined #ocaml
lordjim has quit [Read error: 60 (Operation timed out)]
wazze has joined #ocaml
lordjim has joined #ocaml
<pattern>
i'm populating array of records within a recursive block... for the sake of having clean code i'd like to have a seperate function that actually populates a record be a seperate function, but i don't want to have to pass the entire array to that function every time
<pattern>
is there any way to do this apart from making the array a global binding?
<teratorn>
make a reference and pass that?
<pattern>
ahh
<teratorn>
i'm not 100% sure on Ocaml's calling conventions though
<teratorn>
it's may already be passing by reference
<pattern>
i thought it always passwed by value
<teratorn>
well yes, I think so
<teratorn>
I mean underlying implementation wise
<teratorn>
I surely isn't pushing the whole damn array on to the stack, and that would be pretty much useless of mutable values anyway
<teratorn>
s/I/It/
<teratorn>
s/of/for/
<teratorn>
so in other words "Don't Worry About It"
<pattern>
well, the reference's value would be a pointer, right?
<teratorn>
*nod*
<teratorn>
why did you say you don't want to pass the entire array?
<Banana>
hello.
<Banana>
i think values are already passed as pointers.
<pattern>
i don't want to pass the entire array for efficiency's sake
<pattern>
it's a large array, and my function would be called many times
<pattern>
they are passed as pointers? cool :)
<pattern>
don't need to mess with references, then
<teratorn>
pattern: well you can tell that is not happening by the fact that you can mutate the array, and you can see said change from the code that calls your function.
<Banana>
pattern: it does not pass the entire array.
<teratorn>
it's passed via a pointer implicitly
<Banana>
inf fact, a caml value is represented by the C type value, which is an alias for long.
<Banana>
if the type is unboxed (int, boolean, constant constructor...) then the long represent the value itself if, not it is a pointer to a block of value.
<Banana>
(basicaly).
<Banana>
(with special treatment for arrays of float for efficiency purpose).
<pattern>
i see
<pattern>
very cool
<Banana>
you thought the array was duplicated during call ?
<pattern>
yeah
<pattern>
i had thought all of ocaml was pass by value
<pattern>
obviously mistaken there
<Banana>
well there is something like that.
<pattern>
yeah, like you said about unboxed values
<Banana>
in fact if you stay purely functionnal, passing by value or by reference is the same.
<Banana>
so it's passed by reference and nobody notice.
<Banana>
since there is no side effect.
<pattern>
what about when there're multiple threads?
<Banana>
interedting...
<pattern>
couldn't one thread mess up another's data if it's really call by ref?
<Banana>
well if it cannot perform side effect i don't think so.
<pattern>
well, say there're two threads, and you pass each one a reference to an array
<Banana>
and if you can perform side effects (like with arrays) you have the usual problem with thread involving mutexes to lock the data.
<pattern>
and each thread tries to populate the array
<pattern>
well, it doesn't have to be an array... i guess any blocked value would work
<pattern>
since they're all passed by reference, right?
<Banana>
if you use list, for exemple, then thread cannot mess them.
<Banana>
because each operation on the list will create a new list.
<pattern>
but the list would still be passed by reference?
<pattern>
well, then it's passed by value, no?
<Demitar>
pattern, do you understand the difference between imperative and functional? (Ie side-effects.)
<Banana>
the point is, that it is passed by reference, but it is not a reference you can modify.
<pattern>
i do understand that difference
<Banana>
so you can call it a value if you want, in the purely functionnal world, that is the same.
<Demitar>
pattern, well if there are no side effects then you don't care if the data is shared.
<pattern>
well, if it's making a copy its effectively passing by value, no?
<Demitar>
Since it's immutable.
<Banana>
pattern: it does not make a copy when you pass it....
<Banana>
let me show you an exemple.
<Banana>
take the List.rev function.
<pattern>
until you told me ocaml made a copy, it seemed that passing by reference necessarily took away the side-effect-free nature of the called function
<Banana>
you have a list l; you call List.rev l; ok ?
<pattern>
ok
<Banana>
what you pass to the function (and what is pushed on the stack) is a pointer.
<Banana>
then the function iterate the list and create the copy of it reversed.
<Banana>
i mean the whole list is not copied to the stack at function call.
<pattern>
yeah, i see what you mean
<pattern>
since it's immutable it doesn't matter that there's a reference to it
<Banana>
yes.
<pattern>
i guess it only matters when the values are mutable and you pass references
<Banana>
the good way to see it (imho) is as mutable data and immutable data.
<pattern>
right
<Banana>
array, ref and mutable records are mutables.
<Banana>
do theses are affected by side effects and so, one as to be cautious when he uses them.
<Banana>
imagine a an array x, and then (f (g a) (h a))
<Banana>
were h and g modify a in place.
<Banana>
theses kind of functions are dangerous.
<pattern>
right
<Banana>
because evaluation order is not specified.
<pattern>
yep
<pattern>
i understand now
<Banana>
so you don't which of h or g is called first.
* pattern
nods
<pattern>
thanks for clearing that up for me
<Banana>
you are welcome.
<Banana>
well did not have a decent meal in 3 days.
<Banana>
time to get one.
<Banana>
bye.
<pattern>
3 days? wow... hope it was voluntary
<pattern>
is there a memory profiler for ocaml?
<pattern>
my program bloats up to 136 MB while processing an 8 MB file, and i need to find out why
kinners has joined #ocaml
cjohnson has joined #ocaml
kinners has quit [Remote closed the connection]
karryall has joined #ocaml
rox has quit [Read error: 110 (Connection timed out)]
owll has joined #ocaml
owll has quit [Client Quit]
mattam_ has joined #ocaml
CosmicRay has joined #ocaml
mattam has quit [Read error: 110 (Connection timed out)]
CosmicRay has quit [saberhagen.freenode.net irc.freenode.net]
karryall has quit [saberhagen.freenode.net irc.freenode.net]
srv has quit [saberhagen.freenode.net irc.freenode.net]
drworm has quit [saberhagen.freenode.net irc.freenode.net]
teratorn has quit [saberhagen.freenode.net irc.freenode.net]
CosmicRay has joined #ocaml
karryall has joined #ocaml
srv has joined #ocaml
drworm has joined #ocaml
teratorn has joined #ocaml
derfy has joined #ocaml
cjohnson has quit ["Drawn beyond the lines of reason"]
jave_work has joined #ocaml
<CosmicRay>
Is there a "repeat string" operator in OCaml? For instance, "-" * 8 would be "--------"
<karryall>
no
<CosmicRay>
rats. thanks :-)
det has quit [Read error: 110 (Connection timed out)]
<CosmicRay>
how about for lists?
<CosmicRay>
["-"] * 8 would produce ["-"; "-"; "-"; "-"; "-"; "-"; "-"; "-"]
<karryall>
neither
det has joined #ocaml
<CosmicRay>
foo.
<Smerdyakov>
This is very easy to implement.
<Smerdyakov>
If you only use a single character, there already is a standard function to do it.
<CosmicRay>
oh?
<CosmicRay>
I wound up doing this:
<CosmicRay>
let rec strrpt ?(accum=[]) str join count = match count with
<CosmicRay>
I really need to also have an internal separator ala String.concat.
<Smerdyakov>
That will only work for repeating a character, though.
<CosmicRay>
bah. can't believe I missed that.
<CosmicRay>
next problem... I need to force the compiler to know that an argument to a function is a particular type, or that the return value is a particular type
<CosmicRay>
it's generating 'a which is leading to trouble
<CosmicRay>
and I can't quite work out the right syntax
<Smerdyakov>
Why is that leading to trouble?
<Smerdyakov>
(Also, I doubt the syntax for this is not found in any decent tutorial of your choosing.)
<CosmicRay>
I'm not quite sure
<CosmicRay>
I've just checked two, plus the Book :-)
<CosmicRay>
a common thread for all the tutorials is a very poor table of contents :-(
<Smerdyakov>
Well, did you know that the OCaml manual has a complete grammar for the language?
<Smerdyakov>
So you should never need to flounder around guessing syntax.
<Smerdyakov>
Why are you using polymorphic variants?
<karryall>
ah you're using objects
<karryall>
you normally can't have unbound type variables in methods types
<CosmicRay>
Smerdyakov: it's a long story (I posted about it on ocaml-beginners though)
<CosmicRay>
oh, a method is special?
<CosmicRay>
Smerdyakov: basically, in some places, I want to accept any of my main three types (as a "field"), while in other areas, I want to restrict to just one of those.
<karryall>
yeah, in an object all type variables must be bound somewhere
<CosmicRay>
Smerdyakov: and I want to be able to go from the specific to the generic.
<Smerdyakov>
CosmicRay, the usual ML way to do such things is to have "injection" constructors.
<Smerdyakov>
CosmicRay, like you have:
<karryall>
you have to put type annotations then
<Smerdyakov>
type myInt = Int of int
<CosmicRay>
karryall: what exactly does that mean? that I must somehow tell the system that the return value is...
<Smerdyakov>
type myFloat = Float of float
<karryall>
but it will be a pain to use
<Smerdyakov>
type myHybrid = HybridInt of myInt | HybridFloat of myFloat
<Smerdyakov>
CosmicRay, so you are causing yourself lots of headache for no good reason. You have no problems with type inference when a value can't have multiple types.
<CosmicRay>
Smerdyakov: I'm not sure that makes it any easier... with your way, now I have to convert/extract between HybridInt and just myInt all the time
<Smerdyakov>
CosmicRay, right, which is easy.
<Smerdyakov>
CosmicRay, and generates much simpler error messages when you do something wrong.
<CosmicRay>
Smerdyakov: there's no way to do that aside from match all over, is there?
<CosmicRay>
Smerdyakov: I was told on -beginner that these ` types were the way to go :-)
<Smerdyakov>
I'm not sure what you mean. You can use let with irrefutable patterns.
<Smerdyakov>
Maybe you were told by other beginners. ;)
<CosmicRay>
heh
<CosmicRay>
what does "use let with irrefutable patterns" mean?
<Smerdyakov>
let Float f = valueOfMyFloat in ...
<CosmicRay>
I don't quite follow...
<CosmicRay>
how does that extract the "x" from "MyFloat x"?
<Smerdyakov>
let bobo = MyFloat 1.0 in
<Smerdyakov>
let Float f = bobo in
<Smerdyakov>
Printf.printf "%g\n" f;
<Smerdyakov>
Prints 1.0
<CosmicRay>
hmm.!
<CosmicRay>
I thought "let Float f" was a function definition
<Smerdyakov>
No. Variable names can't start with capital letters.
<CosmicRay>
hm.
<CosmicRay>
what does "Float" do there then?
<Smerdyakov>
That is just shorthand for:
<Smerdyakov>
let f = match bobo with Float f -> f in
<Smerdyakov>
(Since the one match rule given in the let matches all possible values)
<Smerdyakov>
I think there should be huge, bold warning text in every place where polymorphic variants are mentioned in a place where newbies might see them. The message should say not to use them unless you can pass a test that shows you understand the basic ML type system. :P
<Smerdyakov>
(Personally, I've never seen _any_ reason to use them.)
<pattern>
is there a better way to create a list of ints from 0 to x than this? "let f x = let rec ff y acc = match y with z when x = z -> acc | y -> ff (y+1) (y::acc) in ff 0 [] ;;" like maybe a ".." operator?
<CosmicRay>
so let's say I have a value of one of these hybrid types, and I'd like to use match to extract the underlying int, float, string, etc...
<CosmicRay>
can I say match x with HybridInt PInt x -> (do something with x) ?
<Smerdyakov>
pattern, I think using if instead of that odd match would be better. :P
<karryall>
Smerdyakov: for big complex interfaces, they help a lot (think lablgtk)
<pattern>
smerdyakov, yeah, that helps, thanks
<Smerdyakov>
CosmicRay, no, you need more parenthesization, and the match you give could raise an exception if you don't use it with a HyrbidInt.
<karryall>
CosmicRay: the problem is polymorphic variants introduce type variable everywhere and that's not good for objects
<CosmicRay>
how would my parenthization go?
<Smerdyakov>
match x with HybridInt (PInt x) -> (do something with x)
<pattern>
cosmicray, "match myhybrid with Int x -> x + 1 | Float y -> y + 1"
<Smerdyakov>
karryall, I'm not familiar with lablgtk, but I think most likely I'd rather do things the traditional way.
<Smerdyakov>
pattern, no
<Smerdyakov>
pattern, that is wrong in at least 2 distinct ways. Good work. ;)_
<pattern>
why?
<Smerdyakov>
Int and Float are constructors for different types.
<Smerdyakov>
y + 1 is not well-typed.
<Smerdyakov>
And, if it _did_ do what you probably meant, the two bodies of the match would have different types!
<Smerdyakov>
So I'd say that's 3 errors. ;)
<pattern>
yes, y + 1 was a typo :) i rely on the compiler too much to catch those :)
<Smerdyakov>
Nothing made with Int has type hybrid.
<Smerdyakov>
Same for Float.;
<pattern>
<Smerdyakov> Int and Float are constructors for different types. <- i assumed your hybrid type was of Int of in | Float of float
<pattern>
in=int
<Smerdyakov>
pattern, nope. I gave the definition earlier.
<pattern>
sorry, i don't see where your hybrid type is defined
<pattern>
type hybrid = Int of int | Float of float ;; (* what i was thinking of *) match myhybrid with Int x -> x + 1 | Float y -> y +. 1.0 (* should then work *)
<pattern>
except that it would still return different types :(
<pattern>
need to correct that...
<pattern>
type hybrid = Int of int | Float of float ;; match myhybrid with Int x -> Int ( x + 1 ) | Float y -> Float ( y +. 1.0 ) (* ok.. how does this look? *)
<pattern>
and here's my clarified incremental list creation function: "let f x = let rec ff y acc = if x = y then acc else ff (y+1) (y::acc) in ff 0 [] ;;"
<Smerdyakov>
<Smerdyakov> type myInt = Int of int
<Smerdyakov>
<Smerdyakov> type myFloat = Float of float
<Smerdyakov>
<Smerdyakov> type myHybrid = HybridInt of myInt | HybridFloat of myFloat
<Smerdyakov>
That is the definition we were working with.
<pattern>
ah
<pattern>
missed that
<pattern>
why do it that way?
<Smerdyakov>
It's an example based on code that CosmicRay is already using.
<pattern>
i see
<Smerdyakov>
The parts of his code he shared do look somewhat suspicious, though.
<pattern>
sorry i butted in... i see you have this well in hand :)
maihem has joined #ocaml
jave_work has quit [Remote closed the connection]
mattam_ is now known as mattam
<CosmicRay>
Is there a way to make the program print out the stack when an exception occurs?
<CosmicRay>
(similar to Python or Java)
<smkl>
compile with debug symbols, then use ocamlrun -b
derfy has quit []
slashvar[LRI] is now known as slashvar[lri_gon
slashvar[lri_gon is now known as slashvar[lri]
cjohnson has joined #ocaml
Nutssh has joined #ocaml
Nutssh has quit ["Client exiting"]
Nutssh has joined #ocaml
rox has joined #ocaml
<Demitar>
CosmicRay, or even more convenient set your environment variable OCAMLRUNPARAM="b=1" (still need to compile with -g of course).
<CosmicRay>
ah ha.
<Demitar>
man ocamlrun will tell you the rest of the things you can tweak.
karryall has quit ["go"]
maihem has quit ["Client exiting"]
Demitar has quit ["Bubbles..."]
zbychuk has joined #ocaml
zbychuk has left #ocaml []
<Smerdyakov>
Wow. Greg Morrisett left Cornell.
<Nutssh>
Where to?
<Nutssh>
Ah. Harvard.
<Smerdyakov>
I'm glad I didn't decide to do my PhD at Cornell.
<Smerdyakov>
Things were rather suspicious when Greg didn't bother to be there for the admitted students visit day.
Nutssh has quit ["Client exiting"]
wazze has quit ["Ein Dieb ist jemand, der die Angewohnheit hat, Dinge zu finden, bevor andere Leute sie verlieren"]
lordjim has quit []
Nutssh has joined #ocaml
CosmicRay has quit ["Client exiting"]
det has quit ["changing servers"]
det has joined #ocaml
mattam_ has joined #ocaml
bernard__ has joined #ocaml
bernard has quit [Read error: 54 (Connection reset by peer)]