<teratorn>
i don't see a way to access instance attributes directly, is it possible?
<Riastradh>
I don't think so.
<Riastradh>
It's probably pretty easy to write a camlp4 extension to the 'object' syntax -- 'val foo [= bar] with getter baz and setter quux' or something.
<teratorn>
yum custom syntax =)
<teratorn>
i think ill just use getters and setters :(
lus|wazze has quit ["Syntactic sugar causes cancer of the semicolon"]
polin8 has quit ["Lost terminal"]
<teratorn>
anyone know what's wrong with this:
<teratorn>
let rec get_stdin_lines lst =
<teratorn>
try
<teratorn>
let line =
<teratorn>
input_line stdin
<teratorn>
in
<teratorn>
get_stdin_lines line :: lst
<teratorn>
with
<teratorn>
lst
<teratorn>
done;;
<teratorn>
Syntax error
<Riastradh>
OK, first of all, what's the 'done' there for?
<teratorn>
hmm, dunno :)
<Riastradh>
Get rid of it.
<teratorn>
stupid mistake, i was thinking loops instead of recursion
<Riastradh>
Then, the 'with' there pattern matches, it doesn't just evaluate the expression thereafter if an exception is raised.
<Riastradh>
I think you want:
<Riastradh>
let rec get_stdin_lines lst =
<Riastradh>
try
<Riastradh>
let line =
<Riastradh>
input_line stdin
<Riastradh>
in
<Riastradh>
get_stdin_lines line :: lst
<Riastradh>
with
<Riastradh>
End_of_file -> lst;;
<teratorn>
arg i was thinking it would catch all exceptions
<teratorn>
which isn't good, anyway
<teratorn>
let me see
<teratorn>
This expression has type string but is here used with type 'a list
<teratorn>
any idea man? i'm confused
<Riastradh>
What gives you that exception?
<teratorn>
those 8 lines
<Riastradh>
What line is underlined?
<teratorn>
none of them :(
<Riastradh>
s/exception/error/1
Kinners has joined #ocaml
<Riastradh>
Oh, duh.
<Riastradh>
You forgot to parenthesize (line :: lst).
<teratorn>
oh heh
<teratorn>
ya know i was wondering if that was needed before i wrote this, so i tryed it in the interpreter
<teratorn>
let foo x = x;;
<teratorn>
# foo 1 :: [2];;
<teratorn>
- : int list = [1; 2]
<teratorn>
so i though all was well :)
<teratorn>
sweet it works
<teratorn>
now i gotta reverse the silly thing =)
<teratorn>
btw, is this a sane/good way to do what it's doing?
<Riastradh>
Fairly.
<teratorn>
it seems hackish to me :/
<Riastradh>
Generally the accumulator function is local to the real function.
<Riastradh>
e.g.:
<Riastradh>
let get_stdin_lines () =
<Riastradh>
let rec loop accum =
<Riastradh>
try
<Riastradh>
loop (input_line stdin :: accum)
<Riastradh>
with
<Riastradh>
End_of_file -> List.rev accum
<Riastradh>
in loop []
<teratorn>
ah that is nice
<teratorn>
thanks
<Riastradh>
If you don't care about stack overflows, but you did care about the overhead of reversing lists, you could do:
<Riastradh>
If you cared about both tail-recursiveness and no reversing overhead, you could use a CPS version:
<Riastradh>
let get_stdin_lines () =
<Riastradh>
let rec loop k =
<Riastradh>
try
<Riastradh>
let line = input_line stdin in
<Riastradh>
loop (fun tail -> line :: tail)
<Riastradh>
with
<Riastradh>
End_of_file -> k []
<Riastradh>
in loop (fun x -> x);;
<teratorn>
great, i'm gonna save all those for future reference :)
<teratorn>
just run it all through my clipboard filter to remove your handle :)
<Riastradh>
If OCaml eliminates the overhead of closure creation, then the CPS version will probably be fastest.
<Riastradh>
It both is tail-recursive and has no overhead of reversing at the end.
<teratorn>
what does CPS stand for btw?
<Riastradh>
Continuation-Passing Style.
<teratorn>
ah
<Riastradh>
It's also not too different from the non-tail-recursive function.
<Riastradh>
Instead of having an accumulator argument, you have an accumulator -continuation- or accumulator -function-.
<teratorn>
i see
<Riastradh>
Er, whoops.
<Riastradh>
The call to 'loop' should be: loop (fun tail -> k (line :: tail))
<Riastradh>
When it gets to the end, k is called with the initial tail -- [].
<Riastradh>
(fun tail -> k (line :: tail)) calls the previous continuation (which is the same thing) with the last line consed onto []; that continuation calls the even previous continuation with a new tail, and so on and so forth, until it gets to the first continuation, with which 'loop' was first called -- the identity function -- which returns the accumulated list of lines.
<Riastradh>
The calls to loop are always in tail positions, so they get tail-call eliminated; likewise with calls to k.
<teratorn>
a tad more complicated that sys.stdin.readlines() ;)
<Riastradh>
Read what I said again carefully -- you'll see it's actually quite simple.
<teratorn>
yeah i will read it until i fully understand
<teratorn>
i'm completely unused to any functional programming style
det has joined #ocaml
lurker has joined #ocaml
<det>
type bar = {f:'a.'a -> int}
<det>
what does that mean ?
<Riastradh>
It means that f can take any type of argument but must return an int.
<Riastradh>
You can do:
<Riastradh>
let my_bar = { f = fun _ -> 5 };;
<Riastradh>
and then:
<Riastradh>
my_bar.f "foo";; my_bar.f 52;;
<Riastradh>
and it will still work.
<det>
that seems rather pointless :/
<Riastradh>
For some things, it is.
<det>
why not just store 52 :)
<det>
or a function that takes unit
<Riastradh>
?
<det>
erm
<det>
5
<det>
not 52
<Riastradh>
Well, it's useful for some things.
<det>
how about this ..
<Riastradh>
See the first section of the OCaml Manual -- specifically, the section on the object system, and polymorphic methods.
<det>
is it possible to have a record of 'a and a a bunch of functions that take 'a as the first argument but the rest of the types are knwn ?
<det>
specificly I am trying to create a vtable without having to constantly create closures
<Riastradh>
Why don't you want closures?
<det>
well, let's say I want a list, but send it to a function that takes a geneeric sequence type (a record of closures), then every cons requires create a bunch of closures
<det>
s/create/creating/
<det>
i was wondering if it was possible to have a type like {object: 'a; first: 'a -> int; rest 'a -> 'a; cons: int 'a -> 'a}
<det>
well, all the methods would be in a seperate structure, so it wouldnt need to be created more than once
<det>
so, you could do something like value.methods.first value.object
<det>
I dont think I am explaining very clearly
<det>
I thought that first type I pasted might be similar
<det>
what does the '." mean in it ?
rhil_zzz is now known as rhil
<det>
scared you away :)
foxster has joined #ocaml
<det>
maybe this will help illustrate
<det>
I would like to do something like this:
<det>
type foo {size: int}
<det>
let foo_idrawable = {
<det>
fun draw f -> Printf.printf "draw a size %d foo" f.size
<det>
fun erase f -> Printf.printf "erase a size %d foo" f.size
<det>
}
<det>
let drawable_object = {value={size=5}; methods=ifoo}
<det>
erm
<det>
ifoo should be foo_idrawable
lurker has left #ocaml []
Smerdyakov has quit ["sleep"]
<det>
how do you index a string in ocaml ?
<teratorn>
str.[offset]
<det>
ahh, thanks
<det>
how could I create a string of elements 1 on from a string without copying
<det>
like car of a list
<det>
or is that not possible without copying
<teratorn>
huh?
<teratorn>
that doesn't make sense
<det>
the C equivalent would be like this, "char *s = "hello"; s2 = s + 1;" then s2 would be "ello"
<det>
char *s2 = s + 1, that is
<teratorn>
hmm
<teratorn>
i don't think you can do that, but i'm no expert
<det>
oh, ok
<det>
how can I check if a string is empty ?
<teratorn>
String.length str = 0
<teratorn>
assuming that's the proper idiom, as i said, i'm quite new
<teratorn>
i wish all types could be evalutated as a boolean
<teratorn>
then you could just do if str
<det>
nahh, that's wrong :)
<teratorn>
what's wrong?
<det>
types other than true or false being booleans :)
<teratorn>
blah, it's totally useful :)
<det>
0, "", etc
<teratorn>
i use it all the time in other langs
<teratorn>
yeah empty sequences too
<teratorn>
of course the wouldn't _be_ booleans
<teratorn>
they would simply be evaluatable as truth values
<det>
what's wrong with if List.empty(l)
<det>
assuming List.empty existed
<teratorn>
nothing, it's just extra typing.
<det>
2 seconds for clarity ?
<teratorn>
believe me, it's totally clear the other way
<teratorn>
it can't mean anything else. any non-empty value is true
<det>
well, then there is the incompatibility with type inference :)
<teratorn>
hmm
<det>
let blah l = if l then print_string "TRUE" else print_string "FALSE"
<det>
what is l ?
<det>
:p
<teratorn>
'a of course :)
<det>
nope
<det>
becuase then you are overloading if
<det>
which ocaml can't do
<teratorn>
well i wasn't considering implementation limitations :)
<teratorn>
of which i hardly know anything
<det>
well
<teratorn>
but i don't think this capability would break the language semantics
<Kinners>
the relational operators are overloaded
<Kinners>
"1" > ""
<Kinners>
[1] > []
<det>
true
<det>
I guess you could do it
<det>
but the way ocaml overloads > is also wrong
<Kinners>
how so?
<det>
if you truely wanted to overload if, something like a haskell type class would work
<teratorn>
you lost me :)
<det>
class Boolean a where
<det>
well, I wont go there :)
<det>
ignoe I said that
<det>
I'm just crazy
<det>
that's all
<teratorn>
i'm none too sane myself
<Kinners>
I suppose the future generics support is all that you'd need
<teratorn>
i wish ocaml was python, only crazy-fast, with neato constraints capablity, and insano concurrency
<det>
nahh, ocaml would be cooler than python if it only had first class modules
<teratorn>
uhm
<teratorn>
i'm not gonna start :)
<det>
what does python have that ocaml doesnt ?
<teratorn>
better data structures, dynamic binding, class/type unification, everythings an object let me see :)
<teratorn>
sane syntax
<teratorn>
but granted
<teratorn>
i don't know ocaml very well yet
<det>
better data structures ?
<teratorn>
yeah check out the list methods, for example
<teratorn>
very flexible
<teratorn>
ocaml's data structures aren't too shaby though
<teratorn>
*shabby
<det>
oh, so you are talking about the standard library, not the language itselfg
<teratorn>
oh i forgot, the stdlib is huge and very stable
<teratorn>
nah, the stdlib is seperate from what i was talking about
<teratorn>
it's amazing how much stuff you can do out-of-the-box
<det>
you mean dynamic binding like (python code here) "klass.method(1)" ?
<teratorn>
nah like:
<teratorn>
x = 1
<teratorn>
def foo(bar):
<teratorn>
return x+bar
<teratorn>
foo(3)
<teratorn>
4
<teratorn>
x = 2
<teratorn>
foo(3)
<teratorn>
5
<det>
global variables are evil? :)
<teratorn>
basically you use references if you want stuff like that
<teratorn>
sure they are
<det>
I see absolutely no usefullness in that
<det>
(I am new to ocaml as well)
<teratorn>
in ocaml you use references, but in python, names are always references
<teratorn>
no usefulness in what, exactly?
<teratorn>
it's a stupid example, of course
<det>
refrences are just a record with a single mutable field, I believe
<teratorn>
yes
<teratorn>
anyway, it's not like your really gonna really understand a language w/o using it extensively :)
<teratorn>
no matter what i could tell you
<teratorn>
i though it was stupid i couldn't source one python file from another when i first started learning it
<teratorn>
but then you learn about the module system, and it makes sense
<teratorn>
i want to learn ocaml for those (rare) occasions when i need that compiled speed, or low-level bit-bashing etc
<teratorn>
basically as a better C :)
<det>
# type 'a reference = {mutable value: 'a};;
<det>
type 'a reference = { mutable value : 'a; }
<det>
# let x = {value=1};;
<det>
val x : int reference = {value = 1}
<det>
# let foo bar = x.value + bar;;
<det>
val foo : int -> int = <fun>
<det>
# foo 3;;
<det>
- : int = 4
<det>
# x.value <- 2;;
<det>
- : unit = ()
<det>
# foo 3;;
<det>
- : int = 5
<teratorn>
a better way to assign a reference is x := value
<teratorn>
and get it's value w/ !x
<det>
and with python it's not like you are changing x's pointer, you are modifying a dictionary
<det>
yeah, I've never used references in ocaml
<det>
the syntax is probally nicer than what i did :)
<teratorn>
yeah
<teratorn>
but hmm
<teratorn>
sure, anytime you bind a name, you are modifying a namespace dictionary
<teratorn>
be it globals() or hte __dict__ attribute of a class instance
<teratorn>
it's very consistent how it's done, and it makes introspection easy
<teratorn>
like if you want to serialize an arbitrary instance, you can just grab it's __dict__ and you just serialize that state
<teratorn>
then you can create a new instance with that state an unserialization time
<teratorn>
s/an/at
<teratorn>
but i'm not sure what you mean by "not like you are changing x's pointer"
<det>
the ocaml way changes the actual bits where x is stored
<teratorn>
i think so
<teratorn>
number types aren't mutable in python
<teratorn>
if i say
<teratorn>
x = 1
<teratorn>
x = 2
<det>
yes, 1 get's garbage collected, not change
<teratorn>
2 is a new integer instance, 1 is subject to being garbage collected assuming no other references
<teratorn>
which is very useful, actually
<teratorn>
especially when you are dealing with an extensive OO language
<teratorn>
so you return self.state from a method call
<teratorn>
you can be assured that noone is going to go changing your self.state
<teratorn>
s/so/say
<det>
ocaml mutable is only introduceed by declaring a record field or object value mutable
<teratorn>
ah yes, that's right
docelic has joined #ocaml
docelic has quit ["l8r"]
karryall has quit ["bye"]
Yurik has joined #ocaml
Kinners has left #ocaml []
karryall has joined #ocaml
<teratorn>
damn where the heck are "fun tail" statements talked about in the doco?
<karryall>
there are no statements in ocaml
<karryall>
only expressions
<teratorn>
ok
det has quit [Remote closed the connection]
Demitar has joined #ocaml
Demitar has quit [Client Quit]
docelic has joined #ocaml
<mrvn>
Whats a fun tail statement?
gene9 has joined #ocaml
gene9 has quit []
<teratorn>
i don't know, exaclty
<teratorn>
is there any way to take a pair, and apply it to a function as two arguments?
<teratorn>
anyone awake yet?
<teratorn>
anyone _still_ awake? :)
<Yurik>
yep
<cDlm>
fun f g (a,b) -> g a b
<teratorn>
that's not really what i meant
<teratorn>
say i have let foo x y z = x+y+z;;
<teratorn>
and a = (2,3);;
<teratorn>
foo 1 a = 6
<mrvn>
f (foo 1) a
<mrvn>
let f g (a,b) = g a b
<mrvn>
tuples are allways just one argument. You have to split them manually.
jtra has joined #ocaml
lus|wazze has joined #ocaml
lus|wazze has quit ["Syntactic sugar causes cancer of the semicolon"]
karryall has quit [Ping timeout: 14401 seconds]
karryall__ has joined #ocaml
Zadeh has left #ocaml []
Smerdyakov has joined #ocaml
karryall__ has quit ["week-end !"]
Zadeh has joined #ocaml
lus|wazze has joined #ocaml
lus|wazze has quit ["Syntactic sugar causes cancer of the semicolon"]
lus|wazze has joined #ocaml
lus|wazze has quit ["Syntactic sugar causes cancer of the semicolon"]
lus|wazze has joined #ocaml
mattam_ has joined #ocaml
mattam has quit [Read error: 110 (Connection timed out)]
mrvn_ has joined #ocaml
mrvn has quit [Read error: 110 (Connection timed out)]
mvw has joined #ocaml
mvw has left #ocaml []
<teratorn>
say ive got a list of like 50 words
<Riastradh>
Words being...?
<Riastradh>
Strings?
<teratorn>
and i need to check thousands of other words if they match any of the 50
<Smerdyakov>
Whoa. What could anyone want with so many words?
<Riastradh>
Machine words?
<teratorn>
english words :)
<teratorn>
how would yall implement a fast binary search algorithm?
<Riastradh>
Are thoes other thousands of words going to be in a list?
<teratorn>
no
<Smerdyakov>
I'd use a Map implemented with a balanced binary search tree.
<Smerdyakov>
I think OCaml includes a functor for making such a module.
<Riastradh>
Why not use a hash table?
<Smerdyakov>
Small number of words to check
<Riastradh>
Or, better yet, a trie?
<Smerdyakov>
I guess a trie would be best. :)
<Smerdyakov>
But hash tables would probably have worse performance, depending on average word length.
<teratorn>
does a hashtbl check sequencially? i kindof gathered taht from the fact that new values always overshadow old ones
<Smerdyakov>
teratorn, what does that mean?
<Smerdyakov>
"check sequentially"
<teratorn>
from beginning to end, instead of a binary search?
<teratorn>
so what's a trie?
<Riastradh>
It uses neither -- it hashes values and looks them up based on that.
<teratorn>
yeah im curious what the lookup method is
<teratorn>
if it keeps the hashes sorted, or anything
<Smerdyakov>
You don't know what a hash table is, teratorn?
<Smerdyakov>
That's what it sounds like.
<Smerdyakov>
So read any of the millions of introductions to them :P
<teratorn>
i know exactly what it _is_
<Riastradh>
It doesn't need to -- hash the value, find the remainder of the size of the vector containing the buckets divided by the hash, and then does a sequential search through the buckets -- but the buckets are small, so you don't lose any efficiency from that sequential search.
<teratorn>
but i don't know how ocaml implements it
<Smerdyakov>
I think you can trust that OCaml does nothing unusual.
<Smerdyakov>
And no one uses any kind of sorting with hash tables.
<teratorn>
ok
<Riastradh>
Sorting a hash table is a complete waste of time.
* teratorn
looks up trie
<Smerdyakov>
teratorn, I would use the built-in binary tree map, personally. Tries wouldn't save you much, probably, if anything.
<teratorn>
i'll check them both out
<Riastradh>
It's a tree of characters, each node of which has a boolean -- true if the characters up to that node make a string contained in that trie, false if otherwise.
<mellum>
You could also run your 50 words through gperf :)
<teratorn>
gperf?
<mellum>
a perfect hash function generator
<mellum>
would be a fun project to make it output Ocaml code
<Smerdyakov>
Probably a trivial project..
<mellum>
Well, one would of course try to improve it while at it :)
<mellum>
for example, the length of the string is costly in C, but cheap in Ocaml
cDlm_ has joined #ocaml
cDlm has quit [Success]
foxster has quit [Read error: 113 (No route to host)]
<teratorn>
god the docs are hard to find anything in
<teratorn>
or incomplete..
<Riastradh>
What are you looking for?
<teratorn>
what's a functor?
<Riastradh>
Read the chapter on modules in the first section.
<teratorn>
ok
cDlm_ is now known as cDlm
<teratorn>
man, too many new concepts in too short an amount of time :(
<teratorn>
anyone know if the o'reilly books english translation is coming out any time soon?
<teratorn>
in print, that is
taw has joined #ocaml
<taw>
is there any way to have hash tables being compared in some meaningful manner ?
<taw>
so that a = b if they have the same contents and if a > b, a=c, b=d then c > d
<Smerdyakov>
Why would you want to do that?
<taw>
so that i have order on terms
<taw>
now this order depends on hash internals, and that's wrong
<Smerdyakov>
Terms?
foxster has joined #ocaml
<taw>
type iexpr = Num of int | Add of (iexpr,int) Hashtbl.t | Div of iexpr * iexpr | ...
<taw>
i'm using (iexpr,int) Hashtbl.t so that associativity and commutativity are represented
<taw>
now i need to compare if 2 terms are identical or sort them in consistent manner
<Smerdyakov>
Term is type iexpr?
<taw>
yes
<Smerdyakov>
Oh, I see.
<Smerdyakov>
What does Add mean?
<taw>
linear combination
<Smerdyakov>
Why aren't you using a list of pairs for it?
<Smerdyakov>
If you always enumerate the elements in order and never do special lookups, then a list is better.
<taw>
i do lot of trnasforms on terms, and hash tables are nicer for that
<Smerdyakov>
Example?
<taw>
let merge x x' =
<taw>
let h = Hashtbl.copy x
<taw>
in let _ = Hashtbl.iter (fun xpr cnt -> let cnt' = (cnt + get h xpr) in if cnt' = 0 then Hashtbl.remove h xpr else Hashtbl.replace h xpr cnt') x'
<taw>
in h
<taw>
let imperative_merge h g =
<taw>
let _ = Hashtbl.iter (fun xpr cnt -> let cnt' = (cnt + get h xpr) in if cnt' = 0 then Hashtbl.remove h xpr else Hashtbl.replace h xpr cnt') g
<taw>
in ()
<taw>
let imperative_factor_merge h g factor =
<taw>
let _ = Hashtbl.iter (fun xpr cnt -> let cnt' = (factor * cnt + get h xpr) in if cnt' = 0 then Hashtbl.remove h xpr else Hashtbl.replace h xpr cnt') g
<taw>
in ()
<taw>
and whole files of things like that
jao has joined #ocaml
mvw has joined #ocaml
<mvw>
impressing team
<mvw>
is there a general irc channel for icfp2003 and has anybody seen an erlang team?
<Smerdyakov>
mvm, do you mean the conference or the contest?