<whee>
alternative syntax the camlp4 guy whipped up
<sfogarty>
camlpf?
<whee>
the preprocessor pretty printer for ocaml
<whee>
camlp4 does syntax extensions and macros and streams and tons of other things
<sfogarty>
hm. it is just ocaml, but different syntax?
<sfogarty>
aah
<whee>
it's really powerful
<sfogarty>
doesn't seem much different yet
<sfogarty>
not so much liking the brackets everywhere
<sfogarty>
tis why i don't like list
<sfogarty>
lisp
<sfogarty>
so, how would you do the above in the new form?
<whee>
have a recent ocaml installation?
<whee>
put whatever functions you want in some file, then run camlp4o pr_r.cmo thatfile
<whee>
it'll parse a file in the original syntax and output the revised
<sfogarty>
yup
<sfogarty>
3.06
<sfogarty>
sweet
<sfogarty>
is this going to become more standard?
<whee>
it does use quite a bit more braces and brackets but I find it helps readability
<whee>
I doubt it
<whee>
I don't know if it's going to 'replace' the default syntax any time soon
<sfogarty>
I don't like the extra braces/brackets. I like do..done better than do {...}. I like x::y::xs better than [x;y::xs]. For one, I'm not sure if the second is x::y::xs or x;(y::xs) just by looking at it
<whee>
it's really not that big of a deal though since it's entirely up to the programmer's tastes
* sfogarty
nods.
<sfogarty>
I'm just giving comments :)
<whee>
I think you'd like the lisp parser :D
<sfogarty>
*shudder*?
graydon has quit [Ping timeout: 14400 seconds]
<whee>
there's a syntax extension bundled with camlp4 that does it lisp style with s-expressions
<whee>
I'd make up an example but I can't understand it half the time heh
<sfogarty>
lisp style? I don't like list *hide*
<whee>
(value patt_id
<whee>
(lambda (loc s)
<whee>
(match ([] s 0)
<whee>
((range 'A' 'Z') <:patt< $uid:s$ >>)
<whee>
(_ <:patt< $lid:s$ >>))))
<sfogarty>
AAAHHHH! NEEVER! NOOOOO!
<whee>
you know you want to use it:D
<sfogarty>
NOOOOOOO!
<whee>
appears to be an sml parser here too
<sfogarty>
oooH!
<sfogarty>
that'd be useful
<sfogarty>
from or to sml?
<whee>
from
<whee>
I don't see a pretty printer for it, just a parser
<whee>
but you should be able to go from sml to ocaml syntax
<whee>
lemme test
<sfogarty>
hehe. looking at the revised stuff. this is neat
<whee>
heh I don't know sml. oops
<sfogarty>
want an sml segment?
<sfogarty>
I've got a book of em
<whee>
sure
<sfogarty>
if I can find it
<sfogarty>
can't find it just now
<sfogarty>
hm
<sfogarty>
oooh. I like what it did here
<sfogarty>
the where is kidna nice
<sfogarty>
really nice, actually
<sfogarty>
although i don't like the value/let...in separation
<whee>
I really like that distinction
<whee>
helps distinguish toplevel declarations and nested ones
<whee>
and I think you'll love the sml parser
<whee>
doesn't implement everything, but it does work rather well
<whee>
fun zip f nil nil = nil
<whee>
| zip f (h::t) (i::u) = f(h,i)::zip f t u;
<whee>
will get parsed to value rec zip a1 a2 a3 =
<whee>
match (a1, a2, a3) with
<whee>
[ (f, [], []) -> []
<whee>
| (f, [h :: t], [i :: u]) -> [f (h, i) :: zip f t u] ]
<whee>
camlp4 pa_sml.cmo pr_r.cmo somefile (you could use pr_o.cmo if you don't want revised output)
<sfogarty>
hm
<sfogarty>
I think i could deal with the new syntac
<whee>
the revised seems more explicit, so I think it's worth the extra typing
<whee>
plus camlp4 itself was written in the revised syntax so it has to be usable heh
<sfogarty>
well, I don't want everything explicit
<whee>
I mean it's a lot easier to tell where one thing starts and another ends
<sfogarty>
andn value isn't a good word, I don't think
<whee>
you could always change it
<sfogarty>
heh
<sfogarty>
that's more effort than it's worth
<sfogarty>
let makes the fact that things are declaritive more noticable
<sfogarty>
I'd rather change it to let...;; and value...in
<whee>
that leads to more typing in the long run
<whee>
and then it gets bad with current 'let .. and .. in ..' constructs
<whee>
value .. and .. in .. looks kind of dumb
<whee>
doesn't read as smoothly
* sfogarty
nods, "I just don't like value."
<sfogarty>
make would be better
<sfogarty>
maybe
<whee>
well we already had val being used so it wasn't too much of a stretch
<sfogarty>
I never used val :)
<sfogarty>
value is just... so non-declaritive. as a word
<whee>
revised just adds two letters and makes the distinction visible in syntaxs
<sfogarty>
hmm
<sfogarty>
I somehow still prefer the let
<sfogarty>
I don't like saying value when I'm declaring a function
<sfogarty>
the where is very nice, but I'm not too fond of most of the other changes
<whee>
it'll grow on you if you start using it
<sfogarty>
maybe I can get em to add where to the next ocaml :)
<whee>
I though it was weird at first heh
<whee>
I don't know how the two syntaxes are going to work together
<whee>
not sure if it's possible to automatically detect the syntax of a file and use the correct parser or what
<sfogarty>
prolly not
<whee>
it'd be easy to distinguish revised and original though
<whee>
just check for value versus let
<whee>
but that'd add an extra step to compilation and I doubt people would want the overhead
<sfogarty>
probably easiest to use a header if youre using revised
<sfogarty>
and a upperlevel to the compiler
incogito has left #ocaml []
mrvn has joined #ocaml
mrvn_ has quit [Read error: 110 (Connection timed out)]
Submarine has joined #ocaml
xtrm has quit [Remote closed the connection]
lam has quit [Read error: 113 (No route to host)]
lam has joined #ocaml
xtrm has joined #ocaml
malc has joined #ocaml
sfogarty has quit ["User disconnected"]
merriam has quit [Excess Flood]
merriam has joined #ocaml
malc has quit [Read error: 110 (Connection timed out)]
Submarine has quit ["using sirc version 2.211+ssfe"]
gl has joined #ocaml
mrvn_ has joined #ocaml
zack has joined #ocaml
mrvn has quit [Read error: 110 (Connection timed out)]
zack has quit [Read error: 104 (Connection reset by peer)]
zack has joined #ocaml
* zack
is away: torno tra 1 min
* zack
is back (gone 00:00:23)
korben has joined #ocaml
systems has joined #ocaml
systems has quit ["Client Exiting"]
* zack
is away: I'm busy
Yurik has joined #ocaml
Yurik_ has joined #ocaml
Yurik has quit [Read error: 104 (Connection reset by peer)]
Yurik_ is now known as Yurik
Yurik has quit [Read error: 104 (Connection reset by peer)]
korben has left #ocaml []
Yurik has joined #ocaml
malc has joined #ocaml
<Yurik>
malc: hi
<malc>
lo
<xtrm>
hello
<xtrm>
malc: i've a PIII 997 do you want i test you're program file (cf: caml-mailing list)
Yurik has quit ["÷ÙÛÅÌ ÉÚ XChat"]
Yurik has joined #ocaml
malc has quit ["no reason"]
systems has joined #ocaml
Yurik_ has joined #ocaml
Yurik has quit [Read error: 54 (Connection reset by peer)]
Yurik_ has quit ["÷ÙÛÅÌ ÉÚ XChat"]
Yurik_ has joined #ocaml
Yurik_ is now known as Yurik
nerdlor_ has joined #ocaml
<Yurik>
nerdlor_: hi
<nerdlor_>
hey there
systems has quit [Read error: 110 (Connection timed out)]
zack has quit [Read error: 104 (Connection reset by peer)]
Yurik has quit [Read error: 104 (Connection reset by peer)]
Yurik has joined #ocaml
Yurik has quit [Read error: 104 (Connection reset by peer)]
xtrm has quit ["Lost terminal"]
systems has joined #ocaml
nopcode has joined #ocaml
<nopcode>
hey
<nopcode>
in ocaml, how would the definition of the 'left' slot of a binary tree class look like ?
<nopcode>
more specifically, how do i initialize it ? (as there is no nil)
<mrvn_>
typoe tree = Leaf of int | Node of tree * int * tree
graydon has joined #ocaml
<mrvn_>
Something like that?
<nopcode>
interesting
<mrvn_>
or type tree = Nil | Node 'a * tree * tree;
<nopcode>
i was thinking of a different syntax involving "class btree = object.."
<mrvn_>
You would need references or options there.
<nopcode>
oh, so references are explicit ?
<nopcode>
atm i have
<nopcode>
class btree = object
<nopcode>
end;;
<nopcode>
ehrm
<mrvn_>
class tree = object mutable val i:'a mutable val left : tree option ....
<nopcode>
hm
<nopcode>
an option is a slot that can be 'not there' ?
<mrvn_>
or class Node_base = object end class Leaf = object inherit Node_base; mutable val data; end class Middle_Node = object inherit Node_base; val left val right end;;
<mrvn_>
nopcode: type option = None | Some x; basically.
<nopcode>
i see
<nopcode>
ah, not 2 classes, trees are trees ;)
<mrvn_>
Somehow you have to differ between Node and Leafes.
<nopcode>
yeah, leafes have left and right = nil
<mrvn_>
You can use a type or option, use inheritance or use references to itself.
<nopcode>
i see
<mrvn_>
class tree = object (self) mutable val left = ref (self :> tree) end
<nopcode>
so how is the complete syntax for val left ... as an option, initialized with None ?
<mrvn_>
method is_leaf = left = (self :> tree) && right = (self :> tree);
<mrvn_>
^^ if you want references to itself for leafes
<nopcode>
ok, but i dont want that *g*
<mrvn_>
mutable val left = (None : tree Option)
<nopcode>
i always hated that way of expressing it because it just seems wrong to me
<nopcode>
mutable meaning ?
<mrvn_>
you can change it
<nopcode>
i see
<mrvn_>
If you don't need to change it use a type instead of a class. Its faster, smaller and looks nicer.
<nopcode>
sh-2.05a$ ocaml btree.ml
<nopcode>
File "btree.ml", line 2, characters 1-8:
<nopcode>
Syntax error
<nopcode>
hm
<nopcode>
i might want to change it
<nopcode>
like, implement the references as a list and derive every special form of tree from there
<nopcode>
b* etc.
<nopcode>
but atm i just want to learn ocaml ;)
<nopcode>
ah well ok
<nopcode>
type tree = Nil | Node 'a * tree * tree;
<nopcode>
explain that then :)
<nopcode>
* is for concatenating elements to a vector ?
<nopcode>
like :: for lists ?
<mrvn_>
Heres your class:
<mrvn_>
class tree = object
<mrvn_>
val mutable data = 0;
<mrvn_>
val mutable left = (None : tree option);
<mrvn_>
method set_left tree = left <- tree;
<mrvn_>
method is_leaf = left = None (* && right = None *);
<mrvn_>
end;;
<mrvn_>
* is pairing:
<mrvn_>
# (1,1);;
<mrvn_>
- : int * int = (1, 1)
<mrvn_>
Or in this case a tripplet of a 'a and two trees.
<nopcode>
and what is :: then ?
<mrvn_>
Thats for lists
<nopcode>
so * is for vectors and vectors == tupels ?
<mrvn_>
a::b adds a in front of the list b
<nopcode>
yeah, like cons does ;)
<mrvn_>
vectors and tuples/triples/n-tuples are the same for mathematicians.
<nopcode>
and for ocaml ? :)
<mrvn_>
Other languages (like C++) has vectors for dynamic arrays, which is different.
<mrvn_>
nopcode: I would allways call them tuple or tripple or quadruple or n-tuple.
<nopcode>
for lisp a vector is a onedimensional array, which can be extensible
<nopcode>
mrvn_: hm, i see
<mrvn_>
If you say vector people might thing you can get the 3rd element of the vector.
<nopcode>
you can't, with a tuple ?
<mrvn_>
In a tripplet you can only get the 3rd element by disgarding the first two: let (_,_,x) = triplet;;
<nopcode>
hehe, this pattern matching things is really groovy :)
<mrvn_>
does the same but looks different.
<mrvn_>
nopcode: Its also very powerfull.
mrvn_ is now known as mrvn
<nopcode>
so you can't recursively walk a tuple ?
<nopcode>
so tuple are not changable in length, i suppose
<mrvn>
nope.
<mrvn>
You can only make a new one.
<nopcode>
mrvn: hmm, can you use pattern matching to say "i get a tree and i want val_l and val_r to be bound to the value of the left and right node, respectively ?
<nopcode>
(given that those exist)
<mrvn>
If you want to iterate/recurse you need a list or an arrays.
<mrvn>
-s
<nopcode>
k
<mrvn>
type tree = Nil | Node int * tree * tree
<mrvn>
let make_leaf x = Node (x, Nil, Nil)
<mrvn>
let make_tree x left right = Node (x, left, right)
<mrvn>
let foo tree = match tree with Nil -> () | Node (x, left, right) -> x
<mrvn>
Like that?
<mrvn>
s/()/0/
<nopcode>
not sure.. :)
<mrvn>
or let foo = function Nil -> 0 | Node (x, left, right) -> x
<nopcode>
i mean a function that gets a tree and, say, returns a tuple of the value of the left and the right node
<nopcode>
can you in that case decompose the tree structure by pattern matching to get the values bound ?
<mrvn>
After the matching above you have x, left and right bound to the value, the left tree and the right tree. You can do whatever you want with them.
<nopcode>
i see
<nopcode>
what's the xemacs mode for ocaml called ?
<mrvn>
I use tuareg
<nopcode>
whats that ?
<mrvn>
a mode
<nopcode>
i see :)
<mrvn>
put (load "append-tuareg") into your custom.el
<systems>
use vim
<systems>
kill emacs
<systems>
dies emacs die
<mrvn>
at least it can make coffee
<nopcode>
systems: vim can never be as flexible as emacs
<nopcode>
never ever =)
<systems>
but do you want it more flexible then it already is
nopcode has quit ["Lost terminal"]
<systems>
you want a text editor with ide like capabilities and tons or scripts
<systems>
you use vim
nopcode has joined #ocaml
<nopcode>
re
<mrvn>
systems: I want an editor and not a blown up single line editor.
<mrvn>
Does you vim highlight the broken passage for a compile error?
Yurik has joined #ocaml
<Yurik>
re
<nopcode>
mrvn: in type tree = Nil | Node int * tree * tree
<nopcode>
i'd have to have Nil and Node defined, right ?
<mrvn>
No, that defines them.
<nopcode>
File "btree.ml", line 1, characters 23-26:
<nopcode>
Syntax error
<nopcode>
;/
<Yurik>
nopcode: Node of int * ...
<mrvn>
mea culpa.
<nopcode>
ok, works =)
<mrvn>
Everything that starts with an upper case is a constructor of a type.
<nopcode>
how do i load that file into the interpreter and get a read-eval-print loop ?
<nopcode>
hm, oh
<mrvn>
Anyone know if ocaml defines PI somewhere?
<mrvn>
nopcode: cut&paste
<nopcode>
mrvn: argh
<mrvn>
nopcode: M-x eval-buffer ?
<nopcode>
don't have the mode :)
<mrvn>
you can start an ocaml im emacs and cut&paste there if you have no mice
<nopcode>
then make_tree key (tree_insert left n) right
<nopcode>
else make_tree key left (tree_insert right n)
<nopcode>
-----
<mrvn>
| Node (key, left, right) with n < key -> make_tree key (tree_insert left n) right
<mrvn>
| Node (key, left, right) -> make_tree key left (tree_insert right n)
<mrvn>
alternatively.
<nopcode>
oh, so with adds an expression to the pattern ?
<mrvn>
Next step would be to use Red/Black trees or 3/4 Trees and balance them.
<nopcode>
ey ;)
<mrvn>
nopcode: iirc yes.
<nopcode>
it flags the with as syntax error
<mrvn>
s/with/where/ ?
<nopcode>
still :)
<mrvn>
"when"
<mrvn>
Never actually used that yet.
<nopcode>
k, works :)
<nopcode>
but looks nicer than using if explicitly
<nopcode>
so this will now produce a new tree sharing the most possible with the original one, right ?
<mrvn>
There are allways different ways and tastest to do something
<nopcode>
sure :)
<mrvn>
nopcode: No. using classes you could share even more.
<nopcode>
why is that ?
<mrvn>
or with references.
<mrvn>
The value you change and the path above it to the root is allways new.
<nopcode>
yeah, sure
<nopcode>
has to be
<nopcode>
because if a change is made somewhere to the left of the root, that has to be a new tree (?)
<mrvn>
With references or mutables you can keep the part above too.
<nopcode>
but it would change the original tree then
<mrvn>
But then you won't get a new changed tree but change the old tree.
<nopcode>
yeah, right
<mrvn>
But that wouldn't be functional. :)
<nopcode>
yup :)
<nopcode>
so lets see, with this method, insertion into a tree requires creation of (height(tree) + 1) nodes, right ?
<mrvn>
You should write Tree.fold_left fold_middle fold_right iter_left iter_middle iter_right
<nopcode>
i cant even parse that ;)
<mrvn>
nopcode: yes, which are O(values in the tree)
<nopcode>
nah, log2 n ?
<mrvn>
nopcode: insert 1, 2, 3, 4, 5, 6...n into your tree in that order. What do you get?
<nopcode>
a list
<mrvn>
A tree thats n levels deep, not log2 n.
<nopcode>
oh, ok ;)
<nopcode>
so log2 only for full trees
<mrvn>
let rec iter_left f = function Nil -> () | Node (x, left, right) -> iter_left f left; f x; iter_left right
<mrvn>
iter_left walks through the tree traversing first the left side, then the value and then the right side of a tree.
<nopcode>
preorder then
<mrvn>
iter_middle looks at the value first and iter_right goes down the right side first.
<nopcode>
ah, no, inorder =)
<mrvn>
For a proper tree implementation you would want functions like that.
<nopcode>
yeah but rather something like iter_left f left :: f x :: iter_left f right
<nopcode>
:)
<nopcode>
ah, no...
<nopcode>
that won't work
<nopcode>
but you need to get the results of the f computation somehow
<mrvn>
iter functions normaly do something with each element and return nothing.
<nopcode>
uh ;)
<mrvn>
fold functions do something with each element and return something (which gets passed to the next f call)
<gl>
iter f list applies f to all elements of the list.. afaik
<nopcode>
hmm
<mrvn>
let sum list = List.fold_left (fun x y -> x + y) 0 list;;
<mrvn>
let print list = List.iter (fun e -> print_int e) list
<gl>
nopcode: ocamlbrowser, then search the function prototypes
<mrvn>
Like that.
<nopcode>
hm
<nopcode>
so fold_left is like reduce ?
<nopcode>
* (reduce #'+ '(1 2 3 4))
<nopcode>
10
<mrvn>
Anyone now why thers a Array.iteri but no List.iteri ?
<nopcode>
let sum list = List.fold_left (+) 0 list;;
<nopcode>
+ is already defined ;)
<mrvn>
let list_reverse = List.fold_left (fun l x -> x::l)
<gl>
List.rev
<mrvn>
let sum = List.fold_left (+);;
<mrvn>
gl: yeah, but what else would you give as example?
systems has quit [Connection timed out]
<nopcode>
so fold_left f is first(list) + fold_left(rest(list)) effectively ?
<nopcode>
ehrm, fold_left f list
<gl>
mrvn: sorry, i didnt see that it was an example
<nopcode>
argh ;)
<mrvn>
nopcode: fold_left folds the list with f from left to right.
<mrvn>
fold_right from right to left
<nopcode>
meaning f (first list) (fold (rest list)) ?
<mrvn>
fold_left f 0 1::2::3::4 => f (f (f (f 0 1) 2) 3) 4
<mrvn>
The result of the first call to f is passed to the second call to f.
<nopcode>
oh, so you have to specificy a first element ?
<nopcode>
btw List. is referencing to a module, right ?
<mrvn>
let ref fold_left f init list = match list with [] -> init | x::xs -> fold_left f (f init x) xs
<mrvn>
s/ref/rec/
<mrvn>
nopcode: The list module.
<mrvn>
nopcode: If you have a file named "tree.ml" in your dir you can use "Tree.something" in another file. List, Array and several others are predefined.
<mrvn>
If you have the ocaml dokumentation installed there.
<nopcode>
# 1::2::3::4;;
<nopcode>
This expression has type int but is here used with type int list
<nopcode>
hmm
<nopcode>
how do i specify the empty list?
<mrvn>
[]
<nopcode>
ah i see
<nopcode>
is there something like fold which operates on single elements at a time ?
<mrvn>
List.iter
<nopcode>
ah hm
<nopcode>
how do make a copy of a list by folding it using the :: function ?
<mrvn>
let iter f l = List.fold_left (fun _ x -> f x; ()) () l;;
<mrvn>
let copy = List.fold_right (fun x xs -> x::xs) []
<mrvn>
But what would be the point in copying it?
<nopcode>
let copy = List.fold_right (::) [];;
<nopcode>
why doesnt this work ?
<nopcode>
just want to understand this :)
<mrvn>
# (+);;
<mrvn>
- : int -> int -> int = <fun>
<mrvn>
# (::);;
<mrvn>
Syntax error
<mrvn>
#
<mrvn>
:: is special
<nopcode>
ehrm ?
<smkl>
:: is a construtor, not operator
<mrvn>
Could be because its right associative
<smkl>
constructor
<nopcode>
oh
<mrvn>
Ah,, yes. its a constructor.
<mrvn>
And then magical
<mrvn>
e.g. 1::2::3::4::5::[];;
<whee>
hooray for magic
<nopcode>
so that's a side effect of the weird syntax ;)
<mrvn>
smkl: From the gramatik :: should be an binary infix operator just like + and -
<mrvn>
smkl: iirc
<nopcode>
it's prolly the right-associativity then
<nopcode>
something else: back to type tree = Nil | Node of int * tree * tree
<nopcode>
shouldn't tree be Tree ?
<whee>
no
<mrvn>
ahh, forget it. ":" is an infix operator but "::" is handled extra.
<whee>
a node is of type int * tree * tree where tree is what you just defined
<whee>
s/node/Node/
<mrvn>
nopcode: Constructors are upper case.
<whee>
tree itself isnt a constructor, so it's not capital
<nopcode>
ah
<mrvn>
Nil, Node, None, Some but tree, option, list
<nopcode>
so Nil and Node both construct trees ?
<nopcode>
what if i defined some other type with a Nil constructor ?
<mrvn>
yep, they construct a tree
<nopcode>
i'm starting to like this language somehow =)
<mrvn>
# type one = Nil;;
<mrvn>
type one = Nil
<mrvn>
# Nil;;
<mrvn>
- : one = Nil
<mrvn>
# let a = Nil;;
<mrvn>
val a : one = Nil
<mrvn>
# type two = Nil;;
<mrvn>
type two = Nil
<mrvn>
# Nil;;
<mrvn>
- : two = Nil
<mrvn>
# a;;
<mrvn>
- : one = Nil
<mrvn>
What should happen?
<mrvn>
Its just like "let foo = 1 let foo = 2"
<mrvn>
type one = Nil | One of int;;
<mrvn>
type two = Nil | Two of int;;
<mrvn>
let foo = function Nil -> 0 | One x -> 1;;
<mrvn>
This pattern matches values of type one
<mrvn>
but is here used to match values of type two
<mrvn>
You shadow the old value with the new one.
<nopcode>
hmm
<nopcode>
well how'd i do that then ?
<mrvn>
Don't call two things Nil in the same Module.
<nopcode>
hm
<mrvn>
use Tree_NIL
<nopcode>
ok :)
<mrvn>
oder make sperate files and thereby different modules.
<mrvn>
-de
<mrvn>
You realy have to be carefull with name collisions. You won't get any warning/error for them as for example in C. The last one is used and usually if theres a conflict the type won't fit.
<whee>
it's not that much of an issue if you split up your programs into logical modules though
<nopcode>
i see
<nopcode>
so, i can use constructors like Nil in place of symbols ?
<nopcode>
like, type color = Red | Green | Blue ?
<whee>
yes
<nopcode>
cool stuff :)
<mrvn>
You have to watch it if you use "open module" for multiple modules. Otherwise you would use Module.function in the code and functions from different modules don#t collide.
<nopcode>
mrvn: so, functions are exported globally but types are not ?
<whee>
you might want to read about polymorphic variants too
<mrvn>
nopcode: If you have a type tree = Red of ... | Black of ... | Nil;; in Module Tree and type color = Red | Black in Module Color you get problems with "open Tree open Colors"
<whee>
open is really something you want to use sparingly
<mrvn>
nopcode: No, nothing is exported. Everything stays inside its Namespace.
<nopcode>
hmm
<mrvn>
nopcode: unless you say "open X", which moves X.??? into your namespace.
<nopcode>
:)
<nopcode>
i dislike merging namespaces
<mrvn>
If you have a "tree.ml" and "balanced_tree.ml", the balanced one might want to open the normal one to include some comon functions.
<nopcode>
oh, well
<nopcode>
but after all, thats the point of using OOP ;)
<mrvn>
If it makes sense to use it you will notice.
<mrvn>
Otherwise don't :)
<whee>
modules can have the same relationship too nopcode
<whee>
add functors and it's good heh
<nopcode>
hm
<nopcode>
can i trace function calls in ocaml ?
<whee>
in the toplevel you can use #trace
<whee>
I think it's #trace <somefunctionname>
<mrvn>
whee: can I do that for exceptions too?
<whee>
no clue D:
gl has quit [Read error: 54 (Connection reset by peer)]
gl has joined #ocaml
<whee>
can't trace raise at least :\
<mrvn>
I had several array out of bounds exceptions earlier and I added a lot of Printf.printf calls to trace them. Not the fastest way.
<whee>
ocamldebug would work though
<whee>
I'd recommend learning how to use ocamldebug to track down things like that
<mrvn>
I probably should.
<whee>
it's not too complicated so it shouldn't be hard to pick up
<mrvn>
Till now I allways fixed it with a few printfs and reading what I typed.
<mrvn>
Its usually a +/- typo or a missing "-1" on the recursion limit.
<nopcode>
#trace doesnt indent...
<nopcode>
whats the best way to find the minimum of a list ?
<mrvn>
List.min or List.fold_left
<nopcode>
i'd use fold_left if i don't want to find the minimun but more general the smallest according to an ordering predicate ?
<mrvn>
Unbound value List.min
<nopcode>
yeah :)
<mrvn>
Problem is: Whats the minimum of []?
<nopcode>
mrvn: yeah, thats what i thought
<nopcode>
is there an imperative way to iterate over a list, like loop ?
<nopcode>
oh, no i know :)
<whee>
there's List.nth, wrap a loop around it and that'd work
<mrvn>
nopcode: for i = 0 to List.length l - 1 do f (List.nth l i) done
<whee>
but there's also List.iter
<mrvn>
Or something like that. But thats stupid.
<mrvn>
whee: List.iter is functional
<whee>
does basically the same thing
<mrvn>
different runtime compared to List.nth
<mrvn>
The ocaml docs should mention which functions are tail recursive and what runtime they each have.
<mrvn>
Kino calls.
<whee>
oh my
<whee>
this is apparently the first day that I don't have tons of work to do. hoorj
<whee>
you won't get much control over allocation and such in ocaml, but it's not that big of a deal
<nopcode>
hm
<nopcode>
how do you parse c structures (files, network protocols) in ocaml ?
<whee>
if you really need that kind of control I would just interface with a c program
<whee>
parse?
<nopcode>
yeah, use :)
<whee>
the Unix module has those types of things
<nopcode>
i see
<nopcode>
ok gonna play some q now, thanks for all the support :)
zack has joined #ocaml
systems has joined #ocaml
nerdlor_ has quit ["ChatZilla 0.8.10 [Mozilla rv:1.2b/20021016]"]
gl has quit [Read error: 104 (Connection reset by peer)]
gl has joined #ocaml
nerdlor has joined #ocaml
zack has quit ["Client Exiting"]
zack has joined #ocaml
Miwong has joined #ocaml
<Miwong>
hello
Miwong has left #ocaml []
systems has quit [Read error: 110 (Connection timed out)]
Miwong has joined #ocaml
zack has left #ocaml []
nerdlor_ has joined #ocaml
nerdlor_ has quit [Client Quit]
systems has joined #ocaml
systems has quit [Client Quit]
two-face has joined #ocaml
<two-face>
hi
<whee>
hye
<two-face>
are you known on caml list ?
<whee>
no
<two-face>
ok
gl has quit [Success]
two-face has left #ocaml []
Miwong has quit ["changing servers"]
<whee>
damn the man for making ocaml a real language
<whee>
the second I start a small project it's already finished and works perfectly and then I'm bored again
<nopcode>
how do i use stuff from Unix ?
<nopcode>
like, Unix.getpid ?
<whee>
yes
<nopcode>
Reference to undefined global `Unix'
<nopcode>
;)
<whee>
I believe you also need to include unix.cmxa or unix.cma or whatever when you compile, depending on whether or not you're using bytecode or native as wsell
<whee>
cmxa for native
<nopcode>
ehrm
<nopcode>
i'm using the toploop
<nopcode>
what would that be then ?
<whee>
#load "unix.cma";; perhaps
<whee>
not exactly sure
<nopcode>
yeah, that worked
<nopcode>
Unix.socket Unix.AF_INET
<nopcode>
Unbound constructor Unix.AF_INET
<nopcode>
hm
<nopcode>
ah ic :)
<nopcode>
got it
<whee>
learning sockets and files was a little confusing for me
<whee>
pay attention to the types and it clears a lot up
Dalroth has quit []
<nopcode>
yeah i just looked into socket_domain
<nopcode>
well whats the way to handle these unix fd's then ?
<nopcode>
ah got it =)
<whee>
you can convert them to channels and deal with those
nerdlor has left #ocaml []
<whee>
could also go a step further and use the Stream module if whatever input you're dealing with would be easier to handle that way
<nopcode>
hmm its about UDP
<whee>
probably not then
<whee>
heh
<nopcode>
;)
<nopcode>
how do i make a string containing 0xFF four times at the beginning ?
<whee>
erm
<nopcode>
well, Unix.write wants a string ;)
<whee>
you could create a string and use String.fill, or use String.make and fill it that way, or tons of other ways
<systems>
it have a top level , aka the interactive shell
<systems>
but no rpm downloads
Yurik has joined #ocaml
<whee>
:|
<whee>
I just got into the habit of editing with vim and recompiling a lot. the interactive toplevel never really got me hooked
Miwong has joined #ocaml
Miwong has quit ["."]
systems has quit [Read error: 60 (Operation timed out)]
gl has joined #ocaml
<Yurik>
gl: hi
<gl>
hi yurik
<whee>
derf anyone have experience with modules and functors?
<whee>
I've got a module (let's call it C) that's a functor with 'type f = Blah.f' where Blah is a module that fulfills sig P
<whee>
now Blah goes and uses a type of int for f, but if I go and try to use a function of Blah that refers to type f and use an integer, it complains that int is not of type Blah.f
<whee>
how do I sort this out :|
<whee>
I guess I start by not using types of Blah.f for arguments. nevermind. heh