<Riastradh>
Yes, but it isn't quite the same thing: if you have a 2D point module with type 't' that describes 2D points, and a 3D point that includes the 2D points and has a type 't' that describes 3D points, are 3D points still 2D points? Can you call a function 'getPointX' on 3D points if it was originally defined on 2D points?
<emu>
have a functor like MakePointOperations
<Riastradh>
Wouldn't it just be easier to have a class?
<pattern_>
("fields" is my list of strings) ...and it's working, except that i have an extra comma at the head of the resulting string
<pattern_>
is there a more efficient/idiomatic way to do this? or am i going to have to lop the comma off the head of the list manually in a post-processing step?
<mrvn>
pattern_: String.concat "," string_list
<pattern_>
ahhh :)
<pattern_>
i knew there must be something
<mrvn>
Allways read the Modules docs for such functions
<pattern_>
i'll use String.concat, then... but how would i do it if it didn't exist?
<pattern_>
yes, i was looking in the "str" module... but didn't check the "string" module
<pattern_>
and i looked in the "list" module too
<mrvn>
let rec loop = function [] -> "" | x::[] -> x | x::xs -> x ^ "," ^ (loop xs)
<mrvn>
Or better: sum up the number of strings - 1 and the length of each string. Create a big string of that size.
<pattern_>
cool :)
<mrvn>
Then copy all strings into the big strings with "," inbetween
<pattern_>
i can also probably look in the source of the String module
<mrvn>
Do that and tell us how they did it.
<pattern_>
i will
<pattern_>
but i have a question about your 2nd solution
<pattern_>
you'd have to also add in the number of commas to that total, right? and then you'd still be stuck with handling the extra comma, right?
<pattern_>
oh, nevermind... the number of strings - 1 is the number of commas
<pattern_>
i like your solution, mrvn... a pattern for each of the corner cases, and recursion on the rest
mattam has joined #ocaml
skylan has quit ["O_O"]
foxen has joined #ocaml
foxen5 has quit [Read error: 104 (Connection reset by peer)]
lament has quit ["Did you know that God's name is ERIS, and that He is a girl?"]
skylan has joined #ocaml
<pattern_>
in the code that calls my function "parse_file" i get a compilation error: "This expression has type unit but is here used with type day list list"
<pattern_>
let parse_file filename =
<pattern_>
let input_file = open_in filename in
<pattern_>
let days = parse_channel input_file in
<pattern_>
close_in input_file ;;
<pattern_>
now, parse_file should be returning a unit, because close_in returns a unit, right?
<pattern_>
but it looks like parse_file is returning "day list list", which is the return value of parse_channel... why?
<pattern_>
i think i may have figured it out: the problem isn't really with parse_file, but with another line that calls parse_channel
whee has quit ["Leaving"]
<pattern_>
though i'm not sure, because i'm now getting syntax errors elsewhere :(
<pattern_>
here is something else i am puzzled by:
<pattern_>
let foo = "a" in
<pattern_>
if foo = "a" then begin
<pattern_>
let baz = "b"
<pattern_>
print_newline ()
<pattern_>
end
<pattern_>
this gives me a syntax error, but if i omit the "let baz" line, it compiles fine... it seems like i can't use "let" in a begin ... end construct
<pattern_>
is that right?
<pattern_>
hmm... think i figured it out: the "let baz" line needs an "in"
rox has quit [Killed (carroll.freenode.net (zelazny.freenode.net <- zheng.freenode.net))]
TachYon26 has joined #ocaml
xkb has quit [Killed (carroll.freenode.net (zelazny.freenode.net <- zheng.freenode.net))]
smkl has quit [Killed (carroll.freenode.net (zelazny.freenode.net <- zheng.freenode.net))]
rox has joined #ocaml
smkl has joined #ocaml
mellum has quit [Killed (carroll.freenode.net (zelazny.freenode.net <- zheng.freenode.net))]
mellum has joined #ocaml
emu has quit [Killed (carroll.freenode.net (zelazny.freenode.net <- zheng.freenode.net))]
emu has joined #ocaml
Kinners has joined #ocaml
Yurik has joined #ocaml
mellum has quit [Read error: 110 (Connection timed out)]
mellum has joined #ocaml
TachYon26 has quit [Remote closed the connection]
xxd_ has quit ["ircII EPIC4-1.1.10 -- Are we there yet?"]
Yurik has quit [Read error: 104 (Connection reset by peer)]
xxd_ has joined #ocaml
Kinners has left #ocaml []
jcore has joined #ocaml
<palomer>
when I do List.fold_right insert ls.l { l = [];ord_fn = ls.ord.fn;is_in_order = true} how does ocaml know how to iterate through that type?
<mellum>
palomer: I don't think that would work at all
<palomer>
it's the code at oreilly's
<palomer>
ah wait, nm
<palomer>
I get it
<palomer>
ocaml is twisting my brain!
<pattern_>
isn't it great? :)
<mellum>
Fold rules.
<mellum>
(although fold_right should be avoided)
<palomer>
really?
<palomer>
why?
<mellum>
Because it's not tail recursive.
<palomer>
so it's slow?
<palomer>
gotcha
<palomer>
btw what does type word = string mean?
<mellum>
It also takes stack memory
<palomer>
I've only seen consructors and records, and that looks like neither
<mellum>
palomer: it introduces a new type, which is in this case just an alias for string
<mellum>
like typedef in C
<palomer>
so each time ocaml sees a string it'll thing it's a word?
<mellum>
Huh? no.
<palomer>
s/thing/think
<palomer>
so whats the use of typedefing a type?
<mellum>
You can define functions that take and return "word". Then later you can change the type to, say, char array, without breaking the interface.
<palomer>
but if I hadn't typedef'd, I would have returned a string instead
<palomer>
which can also type to a char array
<palomer>
unless you have things like (a:word), I don't see the use
<mellum>
right.
<palomer>
man ocaml is huge
<palomer>
it's bigger than c++!
<palomer>
whats the norm when specifying parameters?
<palomer>
elements firsts in the list or lists firsts?
<palomer>
what about functions, do they go before everyone else?
<mellum>
Heh, Ocaml certainly isn't as huge as C++
<mellum>
The C++ standard has 776 pages
<mellum>
Arguments are usually orderd so currying is more useful
<palomer>
currying is parameter order dependant?
<mellum>
So the more fundamental, less changing arguments come first
<palomer>
let x = fun a b c -> match c with...
<mellum>
sure
<palomer>
so functions functions first, lists second. and elements third
<palomer>
gotcha
<palomer>
hrm, why is bad style to do (a,b) when a = b ... | (a,b) when a<b ... | (a,b) when b > a?
<mellum>
An if yould seem clearer here
<palomer>
hrm?
<palomer>
the compiler is telling me it's bad style
<palomer>
Warning: Bad style, all clauses in this pattern-matching are guarded.
<palomer>
how do I avoid super nested if statements?
<palomer>
seems that I have no choice in ocaml
<mrvn>
palomer: (a=0)&&(b=0) instead of if (a=0) then if (b=0) ...
<mrvn>
or subfunctions
<Riastradh>
I don't see why that's 'bad style.'
<palomer>
isn't there a case construct or something
<palomer>
like the when statements that's a bad style:o
<palomer>
that would make my code much more readable
<palomer>
mrvn: will the compiler optimize it?
<Riastradh>
There's nothing like a 'cond' expression in OCaml except for 'match,' so it would be your only choice if you didn't use multitudes of 'if' expressions, which I would say are worse style.
<emu>
eh oh, not quite a standard =)
<palomer>
hrm
<Riastradh>
emu, it's as close to a standard as there is.
<palomer>
the reason my if statements are super nested is because I'm forced to return something in my else statement
<palomer>
it won't let me just follow through
<palomer>
time for a competition!
<palomer>
who can code the most elegant binary search, heres my entry
<palomer>
let bin_search = fun ls elem ->
<palomer>
let rec bin_search_rec = fun start finish -> match (start,finish,(start+finish)/2) with
<palomer>
(s,f,_) when s = f - 1 -> if nth ls s = elem then true else false
<palomer>
| (s,f,_) when s > f - 1 -> false
<palomer>
| (s,f,mid) when s < f - 1 && nth ls mid = elem -> true
<palomer>
| (s,f,mid) when s < f - 1 && nth ls mid < elem -> bin_search_rec mid f
<palomer>
| (s,_,mid) -> bin_search_rec s mid
<palomer>
in
<palomer>
bin_search_rec 0 (list_length ls);;
<palomer>
I don't know the ocaml std function for list_length or nth so I made my own
<palomer>
which means my function runs in n * ln n
<palomer>
but don't let that bother you:o
<emu>
wha
<emu>
why are you using anything like nth
<emu>
arrays!
<emu>
List.length;;
<emu>
# (Array.make 3 1).(1);;
<mattam>
dichotomic search is binary search ?
<palomer>
binary search is a kind of dichotomic search, though others exist im sure
<palomer>
so is my binary searh pretty?
<palomer>
oc can it be done in a more elegant fashion?
<emu>
someone should fix ocaml.org so that it redirects to www.ocaml.org
<mattam>
yes, pretty, although you could have 'let bin_search ls elem = ...' and 'when s = f - 1 -> nth ls s = elem'
<mattam>
also using arrays to reduce time complexity to ln n
<palomer>
binary search on lists is pretty useless:o
Smerdyakov has joined #ocaml
whee has joined #ocaml
mrvn_ has joined #ocaml
mrvn has quit [Read error: 110 (Connection timed out)]
xxd_ has quit ["EOF"]
xxd has joined #ocaml
mrvn_ is now known as mrvn
<palomer>
hrm
TimFreeman has joined #ocaml
<palomer>
hrm
<palomer>
I'm having trouble understanding recursive types
<whee>
like?
<palomer>
type int_or_char_list =
<palomer>
Nil
<palomer>
| Int_cons of int * int_or_char_list
<palomer>
| Char_cons of char * int_or_char_list ;;
<palomer>
Int_cons is a constructor...
<palomer>
hrm, I guess that makes sense...
<palomer>
Seems so different though
<palomer>
why would you want to do that!?
<whee>
as an example, heh
<whee>
you can get a list of ints or chars with something like that
<Riastradh>
A variant of it would be useful in the 'Banana' protocol.
<palomer>
is it really a list?
<palomer>
looks like a super tuple
<Riastradh>
Yes, it is really a list: it is a collection of linked pairs.
<mrvn>
palomer: lists are tuples of 'a * 'a list
<mrvn>
palomer: or []
<palomer>
so it would be let 'a list = Nil | 'a * 'a list ?
<whee>
need a constructor for that second part
<mrvn>
type 'a list = Nil | Cons of 'a * 'a list
<Riastradh>
Pseudo-code: type 'a list = [] | 'a :: 'a list
<palomer>
and can constructors do anymore then give the ability to differentiate between elements of a type?
<palomer>
or help in matching
<mrvn>
palomer: The Constructor is there to differentiate. It becomes an int in the implementation.
TimFreeman has left #ocaml []
<mrvn>
In C that would be like enum list_type = {NIL, CONS}; struct 'a list { list_type type; ['a val; 'a *next;] }, let [] only beeing present for CONS
<mrvn>
You have to allays use the constructor so ocaml knows that to fill in or match against for the list_type
<palomer>
gotcha
<palomer>
so constructors are there for matching
* emu
masters functors!
<emu>
you can compare C's union type as a very unsafe version of ML's sum/disjoint types
<emu>
plus you have to implement tagging yourself in a union
<emu>
or just assume you know what you're doing
<emu>
(your program won't, and will crash =)
<emu>
now to take over the world
<emu>
so now i'm supposed to do something interesting...
<whee>
heh
<palomer>
functors in c++
<palomer>
?
<palomer>
or functors in mathematics?
<palomer>
so lemme get this straight, lists are pairs of pairs of pairs of pairs... ?
<emu>
functors in OCAML
<Riastradh>
Not necessarily.
<emu>
but I was talking about something different the next line
<palomer>
yhea
<Riastradh>
X lists are pairs of X and X lists, which are pairs of X and X lists, etc., or nil.
<palomer>
ohhh
<emu>
lists are built up out of little structures named conses which have a place for an item and a place for the "next" cons
<palomer>
so they're pairs of pairs of pairs
<palomer>
of pairs
<palomer>
...
<Riastradh>
No.
<palomer>
lists are pairs of X and X lists, and X lists are pairs of X lists
<Riastradh>
'Pairs of pairs' indicates, where 'Pair' is a function that creates a pair of its two arguments, 'Pair(<some pair>, <some other pair>)'.
<emu>
type 'a PAIR = First of 'a | Rest of 'a PAIR
<Riastradh>
Uh, no. That's a pair of an integer and a pair.
<Riastradh>
A pair of an integer _AND_ a pair.
<palomer>
ah yes ,there is a distinction
<emu>
oops
* emu
goes disjoint
<palomer>
does that mean I can pass 2,(3,(4,Nil)) insead of a list if I wish to?
<emu>
you use 2 :: 3 :: 4 :: []
<emu>
in OCAML
<Riastradh>
Sure, that has a type: int * (int * (int * 'a list))
<emu>
alternatively [2;3;4]
<Riastradh>
It's rather silly when compared to lists, though.
<emu>
oh wait, are we teaching him about tuples or lists?
<emu>
hehe
<palomer>
the equivalence of it
<emu>
there is no equivalence
<emu>
they are different data types
<palomer>
a list is a pair
<emu>
this gets a little confusing due to some terminology conflation
<emu>
some people call conses pairs
<emu>
other people call 2-element tuples pairs
<emu>
they aren't the same
<palomer>
yhea, ocaml won't let me pass a pair to a function that needs a list
<emu>
stop using the word pair
<emu>
and just use 'cons' or 'tuple', for clarity
<emu>
=)
<palomer>
ok
<emu>
so which do you mean?
<palomer>
from now on pair=2 element tuple
<emu>
so (1, 2)
<palomer>
yes
<whee>
marklar: marklar use marklar for marklar and marklar to avoid marklar with marklar and marklar.
<emu>
obviously
<emu>
tuples are not lists
<palomer>
but a list is a tuple!
<emu>
no it is NOT
<emu>
not in Ocaml
<palomer>
ah
<palomer>
gotcha
<whee>
you can represent a list using a bunch of tuples, but they're not that way here
<palomer>
so it's a built in
<emu>
lists are a built-in type
<emu>
[] is a list
<emu>
it is the empty list
<emu>
1 :: [] is a list
<emu>
it is a list with one element
<emu>
now keep building from there =)
<palomer>
ahh
<emu>
x :: a_list is a list
<emu>
if x has type t, then a_list must have type t list
<palomer>
gotcha
<palomer>
so we can't define a list type as such
<emu>
well
<palomer>
type 'a list = Nil | 'a * 'a list;;
<emu>
you can make your own 'list type' but it won't inter-operate with the normal lists
<emu>
not quite
<emu>
type 'a list = Nil | Cons of 'a * 'a list;;
<palomer>
ah yes
<emu>
need to have a constructor for disjoint types
<palomer>
Disjoint types?
<emu>
yes
<palomer>
hrm?
<emu>
because a variable of a disjoint type can only have one of the possibilities at any one time
<emu>
it's either Nil, or it's Cons ..., not both
<palomer>
ahh
<palomer>
gotcha
<palomer>
so that's what constructors do!!
<palomer>
they should change the name to differentiators
<palomer>
what would happen if we left out the constructor?
<emu>
they're also called variant types I think too
<emu>
it wouldn't work
<whee>
yes, those things are called variants
<palomer>
from now on they're variants
<palomer>
no more constructor pishposh
<emu>
seems that OCAML manual refers to them as variant types
<palomer>
stupid oreilly!
<whee>
there's also polymorphic variants, which are neat
<palomer>
eeek
<palomer>
polymorphism!
<palomer>
does polymorphism incure a performance hit?
<whee>
it can
<whee>
but the compiler handles most of that, so not always
<mrvn>
For example if you have a game with fileds of NIL, X and O and the player `X and `O
<mrvn>
palomer: polymorphism doesn't cost any time. But non polymorphic methods could be implemented fasterby making them static
<palomer>
ah, gotcha
<emu>
all is resolved at compile-time anyway
<emu>
polymorphism is parametric only in ML
<mrvn>
class foo = object method foo = () end
<mrvn>
If you call foo#foo it has to lookup the foo method in the virtual table for the object. In C++ the function would be static and you would just jump to the address.
<mrvn>
emu: all oject methods are resolved at runtime thorugh the virtual table.
<palomer>
ahh, so things aren't static by default
<palomer>
mrvn: how does the comiler know which method to call?
<whee>
mrvn: emu's referring to a different polymorphism
<mrvn>
afaik ocaml doesn't have a static keyword. Could be that making methods private makes them static too.
det has joined #ocaml
<palomer>
what exactly is ()?
<emu>
unit
<emu>
the only value of the unit type
<palomer>
is that like void?
<palomer>
or is it like Object:o
det has quit [Client Quit]
<Riastradh>
Yes, it's what OCaml uses in the place of C's 'void.'
<mrvn>
Its more like NULL
<mrvn>
Its a value, not a type
<palomer>
NULL is an int
<mrvn>
type unit = ()
<palomer>
it's 0
<mrvn>
same a type bla = Foo
<palomer>
hrm?
<steele>
i would say the equivalent of NULL is None in the option type
<mrvn>
yeah, C++ doesn't have ()
<Riastradh>
Where C would return void, OCaml would return unit.
<mrvn>
() is the void in int foo(void)
<Riastradh>
Where C functions would take a void number of arguments, OCaml functions would take a unit argument.
<palomer>
so what does let () = print_string "BRAVO" mean?
<emu>
but unit has one value
<emu>
whereas a true void 0-type would not
<mrvn>
() is used to basically say "this is a function that takes no parameters" or "returns no value"
<steele>
you don't need it in c because returning values is explicit
<emu>
but it is used when nothing else is needed, yes
<Riastradh>
Yes, emu, that's why I said 'what OCaml uses in the place of,' not 'OCaml's "void."'
<emu>
and one of my speakers died. argh.
<palomer>
why not just do print_string "BRAVO"?
<mrvn>
palomer: same as type foo = Foo let foo () = Foo let Foo = foo ()
<whee>
go learn that, and complain that ocaml contains too many paradigms :)
<palomer>
oz is freaky
<palomer>
hrm
<palomer>
simplicity is always best!
<whee>
the idea is to use the design that fits the problem best
<emu>
tell me palomer
<emu>
do you want to use a language that you have to do everything yourself in?
<emu>
or would you prefer to have features available when you need them?
<Riastradh>
Or a language where the semantics are simple, but with a huge library?
<Riastradh>
Er, a language that is by itself very simple, rather.
<emu>
what's a library?
<emu>
=)
<Riastradh>
Bloody Common Lisp programmer.
<emu>
hehehe
<palomer>
:o
<emu>
look, just cuz we can extend the language with more ease than C programmers can write libraries...
lament has joined #ocaml
<emu>
no reason to get all prickly :-P
<Riastradh>
'Extend the language?' You mean add more to the standard?
<Riastradh>
Or do you mean just make use of a very extensible language?
<emu>
well
<emu>
since you can extend the language in a standard way...
<Riastradh>
i.e., one with a full MOP, for example.
<emu>
you don't need MOP to have extensibility
<emu>
it just would be nice if that was standard too, sigh
<Riastradh>
Yes, but it helps.
<emu>
in any case
<palomer>
MOP? HOF?
<emu>
the main point was that you only use what you need
<Riastradh>
MOP = MetaObject Protocol
<palomer>
hrm
<Riastradh>
In CLOS, classes are really instances of the class 'standard-class,' which is an instance of itself.
<emu>
so a large language is no detriment to use
<Riastradh>
You can subclass 'standard-class' to extend CLOS.
<palomer>
isn't ml the meta language, and doesn't that imply it has everything meta?
<emu>
palomer: no, it was the meta language of some odd theorem prover way back
<Riastradh>
No, it was just designed to implement compilers.
<palomer>
oh
<emu>
the name stuck
<palomer>
a mathemitician actually proved his theorems in ml?
<palomer>
Riastradh: so it's good for compiler design?
<Riastradh>
palomer, the OCaml compiler is, last I checked, written in OCaml.
<emu>
most decent compilers are self-hosted
<palomer>
Riastradh: whoa, no wonder it kicks ass
<emu>
admittedly, I wouldn't want to write a C compiler in C
<palomer>
how does it boot strap?
<emu>
but there are people who do..
<emu>
a couple of ways
<palomer>
gcc is written in C
<emu>
i don't remember how ocaml does it
<emu>
i think ocaml builds a mini-compiler which compilers the rest
<Riastradh>
There's probably a minimal binary distribution, or a tiny compiler written in C.
<emu>
I seem to recall 3 stages
<steele>
the bytecode interpreter is written in C
<emu>
I once compiled the debian source package
<emu>
gcc bootstraps off of the host's C compiler by building a mini-C compiler with that
<palomer>
hrm, there should be a single compilable programming language and all the other programming languages just transform themselves into that programming language to be compiled
<emu>
cmucl bootstraps off of prior versions of cmucl. sbcl is attempting to be buildable by any ANSI CL.
<Riastradh>
It's called 'assembly language,' except it varies from platform to platform.
<emu>
JVM attempted too
<palomer>
hrm
<emu>
JVM is a piece of crap
<lament>
palomer: yes!
<palomer>
we should do it in stages
<lament>
palomer: there should be one single language
<emu>
it does not handle langauges with decent semantics well
<palomer>
like have assembly, then c, then all the rest
<lament>
the .NET bytecode
<lament>
;)
<emu>
.NET bytecode suffers all the same problems because MS ripped off Java without even bothering to improve
<palomer>
so that all the optimizations need only be from c to assembly
<whee>
I don't really use the OO things in ocaml much, heh
<det>
can ocaml use printf to infer types ?
<mrvn>
yes
<det>
it seemed to infer a string from: method draw = Printf.printf "I'm a %s foo!\n" color
<det>
neat
<mrvn>
# Printf.printf "%d";;
<mrvn>
- : int -> unit = <fun>
<mrvn>
Otherwise it wouldn't be typesave.
<det>
so Printf.printf is done at compile time ?
<det>
it doesnt actually parse the string at execution ?
<mellum>
yes, you can't use a non-constant format string
<mrvn>
det: yep. Thats why it must be a const string
<mrvn>
a literal
<det>
ohh, yay efficiency :)
<det>
it seems noone here is really interested in ocaml's OO stuff
<det>
if I wanted to write some kind of game where future type could be added (so I couldn't use variants) that supported some kind of "draw" function, OO is the only way to go in ocaml ?
<det>
s/type/types/
<det>
like keep a bunch of items in a list of different, unknown types, and then "draw" them all
<det>
one more thing, this compiles to 173056 bytes (using opt), is most of that a one-time ocaml overhead (GC etc.. of maybe~150 k) and not that this compiled a huge binary for what there is ?
<whee>
yeah, most of that is the basics
<whee>
if not all
<det>
ahh, thanks
det has quit ["ircII EPIC4-1.1.2 -- Are we there yet?"]
det has joined #ocaml
<det>
argh, computer died
<det>
is there any way to put all that "basic stuff" in a shared library so I dont have to pay a "binary tax" if I include several binaries with a distribution ?