Yurik changed the topic of #ocaml to: http://icfpcontest.cse.ogi.edu/ -- OCaml wins | http://www.ocaml.org/ | http://caml.inria.fr/oreilly-book/ | http://icfp2002.cs.brown.edu/ | SWIG now supports OCaml| Early releases of OCamlBDB and OCamlGettext are available
<Vincenz> What's Ocaml's advantage wrt haskell?
<whee> it's a bit faster and easier to deal with, as you don't need to learn monads and how to efficiently code in lazy languages
<whee> but haskell's type system is more advanced, and I like the syntax myself
<whee> and the lazy evaluation part can be pretty useful
<Vincenz> so basically...you're telling me, the newbie, to learn haskell instead of ocaml?
<whee> learn both :)
<whee> they both have their advantages and disadvantages
<Vincenz> and I only have limited time :P
<Vincenz> if I learned both I'd be learning scheme too
<Vincenz> and python (as I chose Ruby over python)
<whee> then go for scheme as well
<whee> heh
<whee> if you learn haskell, you'd have no problem learning any other functional language
<whee> but the same can be said if you went with ocaml or scheme, really
<Vincenz> scheme...it's like lisp: yucky syntax
<mrvn> no static types, yieks.
<whee> no different than that of any other language
<whee> heh
<whee> syntax is easy to learn and really shouldn't be a major factor when picking languages
<Vincenz> I don't know
<Vincenz> lisp more than scheme freaks me out
<Vincenz> (what with the macro system)
<Vincenz> talk about code-readability!
<whee> they both have an extensive macro system
docelic is now known as docelic|sleepo
mattam has quit ["zZz"]
<Vincenz> I don't know, I just have a personal aversion to lips
<Vincenz> lisp
<Vincenz> not lips :P
<Riastradh> Vincenz - Why do you hang out in #scheme, then?
<Vincenz> to log
<Riastradh> But clog logs #scheme.
<Vincenz> in case I ever change my mind
<Vincenz> besides...sinec today..I don't anymore
<whee> heh
<Vincenz> what I like ocaml, speed, fact you can compile to exe
<Riastradh> Speed isn't everything, you know.
<Vincenz> well it seems like a good language
<whee> well you can do that in many languages
<Vincenz> speed is just a side-thing
<Vincenz> l
<Riastradh> And there are -plenty- of Schemes and Lisps and a few Haskell implementations that compile to native code, whether it be directly or through C or something.
<Vincenz> alright, alright
<whee> I stopped caring about speed with languages a while ago
<Vincenz> I don't know I was trying to choose a fp lang
<mrvn> Actually ocaml is pretty bad compilerwise on non-i386
<whee> it's really not that big of an issue with most applications
<Vincenz> and it came down to haskell vs ocaml
<mrvn> Lots and lots of optimisation possible even on i386.
<Riastradh> Your argument about static type checking is silly, too -- there are several Schemes that support it.
<Riastradh> And in Scheme48 you can even write your own static type checker to have all the cool type checking semantics you want.
<mrvn> Riastradh: but normaly scheme doesn#t have static types.
<whee> static typing isn't _that_ big of a deal :P
<Riastradh> mrvn - That is true, but nevertheless, it is definitely possible in several Scheme implementations to do it.
<mrvn> whee: 90% of all bugs are type errors.
<whee> not with my programs :)
<Riastradh> And with Scheme48, you don't need to modify the actual code -- just write a different interface definition.
<Riastradh> That is to say that you can take any R5RS-compliant Scheme code and make an interface and structure definition and make it work in Scheme48 with static type checking and whatever other good module stuff you like.
<Vincenz> Riastradh: which do you prefer, as it seems you use all three
<whee> Vincenz: learn erlang, as well :)
<Vincenz> heh...
<Riastradh> Vincenz - I prefer Scheme, for which reason you might notice I argue for it the most.
<Vincenz> Riastradh: on what basis do you like it most?
<mrvn> I quite like ocamls syntax, modules and objects.
<mrvn> nice and fairly consistent mix
<Riastradh> Most bases. The syntax (and thus macros as well), the implementations, the functionalness, what I consider a decent and simple enough amount of imperativeness as well, continuation manipulation, and things like that.
<mrvn> I don't like IO and strings though.
<mrvn> A callcc for ocaml would be nice.
<Riastradh> And most of all the simplicity, especially of syntax.
<Riastradh> Vincenz - Another indication that I probably prefer Scheme is that I'm the official owner of #scheme.
Kinners has joined #ocaml
<Vincenz> hehe :
<Vincenz> :P
jao has joined #ocaml
<Vincenz> I guess haskell vs scheme vs ocaml is just a matter of personal preference
<Vincenz> (much like python vs ruby vs perl or c vs c++ vs java)
<Riastradh> C vs C++ vs Java is an entirely different thing. C is a low-level, minimalist language; C++ is a low-level, monstrous, maximalist language; Java is a different thing altogether.
<Vincenz> depends on your point of view and your domain, but I guess so
jao has quit [Read error: 54 (Connection reset by peer)]
jao has joined #ocaml
skylan has quit ["Reconnecting"]
skylan has joined #ocaml
jao has quit [Remote closed the connection]
pattern_ has joined #ocaml
<mrvn> C++ includes C so C can never be better than C++
<mrvn> And java has some serious design problems.
<mrvn> like no non-blocking io, no finalise on function arguments, no enums.
<mrvn> and an ever changing interface
<Riastradh> mrvn, what do you mean by 'better' than C++?
<mrvn> faster, cleaner, nicer whatever
<Riastradh> It is my view that C is 'better' than C++ in that it's a better designed language -- they didn't throw in everything that could possibly come to their monstrous minds.
<mrvn> #define C_IS_SHIT
<mrvn> unsigned;
<Riastradh> I of course don't -like- C, but I dislike it -less- than C++.
<mrvn> Thats a realy great C program, isn't it?
<mrvn> C is realy low level. A lot of the design stuff was made so that compilers could function on the lowend machines they had back then.
<mrvn> Worst of all is K&R C.
<mrvn> I try not to use C for anything thats not kernel hacking. Higher level languages are just more robust against human errors.
* Vincenz doesnt mention he mostly codes in JAVA
<mrvn> poor you
<Riastradh> You just did, Vincenz.
<Vincenz> :P
<Vincenz> I don't mind JAVA
<Vincenz> I'm quite proficient at it
<Vincenz> just that you need a lot of code sometimes to do something
* Riastradh writes nearly all his code in Scheme.
<mrvn> not having const qualifiers for function arguments is realy bad in java.
<whee> I've been doing a lot of erlang lately D:
<mrvn> Java and haskel are no options for me allone due to its availability or rather non availability.
<Vincenz> what's erlang like?
<Vincenz> java is available, no?
<mrvn> not realy, not free and not for different archs like m68k or alpha.
<Vincenz> ah k
<Vincenz> what kind of language is erlang?
<mrvn> Using gcj (gnu java compiler) wasn't an option back then. Not sure how complete its runtime is now.
<mrvn> And Haskel has no compiler for alpha, just bytecode.
gene9 has joined #ocaml
gene9 has quit [Client Quit]
<Vincenz> no jvm for alhpa?
<Vincenz> alpha
<mrvn> non-free and outdated if at all.
<mrvn> You can't even get a java for i386 that uses uptodate libs and compilers.
<mrvn> using bleeding edge (debian sid) sometimes does have drawbacks
* Vincenz heads to sleep
Vincenz has quit []
lament has joined #ocaml
RHAJEDU has joined #ocaml
RHAJEDU has left #ocaml []
polin8_ has quit [Remote closed the connection]
polin8 has joined #ocaml
lament is now known as lameAFK
lameAFK has quit [Remote closed the connection]
Kinners has left #ocaml []
palomer has quit [Remote closed the connection]
lament has joined #ocaml
foxster has joined #ocaml
foxster has quit [Read error: 104 (Connection reset by peer)]
foxster has joined #ocaml
mattam has joined #ocaml
ott has joined #ocaml
<ott> re all
<pattern_> hi
xtrm has joined #ocaml
lament has quit ["Did you know that God's name is ERIS, and that He is a girl?"]
pattern_ has quit [brunner.freenode.net irc.freenode.net]
pattern_ has joined #ocaml
Vincenz has joined #ocaml
gene9 has joined #ocaml
K_Oxford is now known as Krystof
foxster has quit [Read error: 104 (Connection reset by peer)]
TachYon26 has joined #ocaml
TachYon26 has quit ["bez ki³y nie ma zaliczenia (z prawd studentek AM)"]
donkey has joined #ocaml
<donkey> hi, i'm curious about the overlap between FP and OO
<donkey> FP seems to make me write less OO in OCaml, and i'm curious about that in big programs
<donkey> it seems C++ has to rely heavily on OO to be even feasible, but when FP is used why is OO needed?
<vegai> OO isn't actually needed
<vegai> it's just used
<donkey> is FP better with OO?
<vegai> is hammer better than screwdriver?
<mellum> donkey: depends on the application. Most problems don't really need OO IMHO.
<donkey> does it lead to simpler, more maintanable programs?
<donkey> ok
<vegai> good programming skills lead to simpler and more maintainable programs
<donkey> it seems the O'Caml OO design is separate anyway, so you don't have to use it
<donkey> is it just a feature to have on the feature list? ;)
<mellum> I guess it was mainly implemented because typing for an OO system is an interesting research project ;)
<donkey> heh, k... what about the relationship between the module system and the OO features?
<donkey> modules seem very popular
<donkey> aren't modules some kind of OO?
<vegai> OO is a buzzword, so ...
<donkey> do modules serve the same purpose as OO?
<donkey> (encapsulation and all)
<donkey> thanks anyway... gtg
donkey has left #ocaml []
mellum_ has joined #ocaml
mellum has quit [Read error: 110 (Connection timed out)]
mellum_ is now known as mellum
nes__ has joined #ocaml
nes__ has left #ocaml []
ott has quit ["ott has no reason"]
lam_ has joined #ocaml
lam has quit [Read error: 104 (Connection reset by peer)]
gene9 has quit []
<vegai> http://caml.inria.fr/FAQ/pgl-eng.html -- best beginner's document so far
<vegai> imho
docelic|sleepo is now known as docelic|away
palomer has joined #ocaml
systems has joined #ocaml
mattam has quit ["Nightfire test"]
xtrm has quit [Read error: 104 (Connection reset by peer)]
docelic|away is now known as docelic
xtrm has joined #ocaml
docelic is now known as docelic|away
systems has left #ocaml []
docelic|away has quit ["Client Exiting"]
<Vincenz> what's the function to make a stream from a string
<mrvn> Stream.make_of_function (fun i -> str.[i]) ?
<Vincenz> just found it, thank you :)
<Vincenz> Stream.of_string
* Vincenz is trying his first hand at writing a parser, having NEVER coded in Ocaml and just having read halfway through a tutorial which still uses old-syntax though
<mrvn> I just used a char list. eats up memory but that was only 20 MB for a 500k source file.
<Vincenz> ???
<Vincenz> is it possible to do
<Vincenz> char^string ?
<mrvn> You might want to make a stream out of the input file insteadof reading it into a string.
<Vincenz> I'm not yet
<mrvn> Vincenz: Buffer can do that
<Vincenz> jsut experimenting with strings I type in the interpreer
<Vincenz> s/typos/no typos/g
* Vincenz uses the nifty ocamlbrowser to look up buffer
<Vincenz> is that a mutable or does it create a new one each time?
<mrvn> mutable
<Vincenz> hmm
<Vincenz> so how would you suppose I build up an identifier?
<Vincenz> let rec identifier =
<Vincenz> [< ''a'..'z'|'A'..'Z' as c; ...
<mrvn> read a char list from the stream, make a string of right size and return a token of Ident * string
<Vincenz> well I'm not planning on using tokens yt
<Vincenz> I first plan on simple parsers that parse integers and identifiers
<Vincenz> and on top of that I'll parse tokens :)
<mrvn> and how do you rewturn them from the parser?
<Vincenz> let rec integer n = parser
<Vincenz> [< ''0'..'9' as c; r = (integer (10*n + int_of_digit c)) >] -> r
<Vincenz> | [< >] -> n;;
<Vincenz>
<Vincenz> type token = INT of int;;
<Vincenz> let rec parsetoken = parser
<Vincenz> [< ''0'..'9' as c; r = (integer (int_of_digit c)) >] -> INT r
<Vincenz> | [< >] -> INT 0;;
<Vincenz> like so :)
<Vincenz> neat, no ?
<Vincenz> (remember I'm a COMPLETE newb here...)
<mrvn> Thats tokens
<Vincenz> yeah!
<Vincenz> but my first parser just parses numbers
<Vincenz> the second one makes a token out of it
<mrvn> type token = INT of int | IDENT of string
<Vincenz> I plan to do the same with my identifier one
<Vincenz> first just a parser that parses the chars
<Vincenz> then on top of that one that gives me back a token
<mrvn> you parse idents as char lists and then implode them into a string.
<Vincenz> ah, hmm, sounds like a good idea :)
<Vincenz> how do I implode a list of chars?
<Vincenz> let rec identifier name = parser
<Vincenz> [< ''a'..'z'|'A'..'Z' as c; r = (identifier (c::name)) >] -> name
<Vincenz> | [< >] -> name;;
<mrvn> let rec implode l = let length = List.length l in let s = String.create length in let rec loop i = function [] -> s | x::xs -> s.[i]<-x; loop (i-1) xs in loop (length-1) l
<mrvn> or something like that
<Vincenz> it reverses it
<Vincenz> # implode ['a';'b';'c'];;
<Vincenz> - : string = "cba"
<mrvn> Thats intentional. You add each char you parse to the front so you need to reverse it
<Vincenz> oh yeah, duh
<mrvn> Vincenz: your parser isn#t tail recursive.
<Vincenz> I'm happy I have a parser at all
<Vincenz> integer is tail recursive, no?
<mrvn> no.
<mrvn> None of those stream prasers are I think.
<Vincenz> I have no idea how I would
<mrvn> I think you can#t.
<Vincenz> oh well
* Vincenz shrugs
<mrvn> Vincenz: start with i=0 and increase it each loop if for your parser.
<mrvn> -if
<Vincenz> damn, won't work
<Vincenz> let identifier character =
<Vincenz> let rec ident name = parser
<Vincenz> [< ''a'..'z'|'A'..'Z' as c; r = (ident (c::name)) >] -> name
<Vincenz> | [< >] -> name in
<Vincenz> implode(ident [character]);;
<Vincenz> won't work :(
<Vincenz> This expression has type char Stream.t -> char list
<Vincenz> but is here used with type char list
<mrvn> to many []
<Vincenz> you can't put a parser inside a function?
<Vincenz> it's on the last line that it fails
<Vincenz> I guess it can't pass the parsing thing
<Vincenz> the Stream, because of the implode call around it?
<Vincenz> yup
<vegai> are there list comprehensions in ocaml?
<Vincenz> it's the implode call that screws it
<Vincenz> any clues on how to fix this?
<vegai> eg. in python: l = [1,2,3]; [a+1 for a in l] -> [2,3,4]
<vegai> I think the idea is from FP-languages, right?
<Vincenz> vegai: don't ask me, I'm a newb
<vegai> I'm asking the community in large, no one in specific =)
<Vincenz> just saying :P
<Vincenz> besides, use ruby and ditch python :P
<vegai> I _know_ that ruby doesn't have lc
<vegai> unless they were recently added
<Vincenz> nope, but you can do the same thing in a different way...
<vegai> with map/filter, I bet
<Vincenz> yup
<vegai> let's not argue about his here, though =)
<vegai> ruby vs python-wars get messy
<Vincenz> true tru
<Vincenz> but I think they're pretty analog, just some things are done differently
<mellum> List.map (fun a->a+1) l
<vegai> ahh, map
<vegai> no direct equivalent to LC?
<Vincenz> hehe :P
<Vincenz> vegai: LC is just syntactic sugar
<mellum> vegai: Why is that not a direct equivalent?
<vegai> yes, perhaps it is
<vegai> pretty nice
<Vincenz> vegai, ruby has pretty much the same syntax :P
<vegai> python as well
<vegai> ah, haskell has LC. I wonder why, then, if map does the same
<Vincenz> vegai: syntactic sugar
* vegai nods.
<vegai> Vincenz: perhaps not on implementation level, though?
<Vincenz> no idea
* Vincenz sighs as his parser doesn't work
<mellum> Syntactic sugar causes cancer of the semicolon.
<Vincenz> hehe
<Vincenz> I never got the underlying point tho
<Vincenz> does that mean syntactic sugar is good or bad?
<Vincenz> (are we fighting the semicolon?
<Vincenz> )
<vegai> mellum: cancer of the semicolon?
<mellum> Yes! We fight the semicolon! Real Ocaml programs contain no semicolons! ;)
<Vincenz> lol
<Vincenz> darnit
<Vincenz> let rec parsetoken = parser
<Vincenz> [< ''0'..'9' as c; r = (integer (int_of_digit c)); spaces >] -> INT r
<Vincenz> | [< ''a'..'z'|'A'..'Z' as c; r = (identifier [c]); spaces >] -> IDENT (implode(r))
<Vincenz> | [< >] -> INT 0;;
<Vincenz> and I do....it on a stream containing "abc 123"
<Vincenz> first time I parse...
<Vincenz> IDENT "abc"
<Vincenz> second time I parse...
<Vincenz> INT 0 (the last case...)
<Vincenz> and it won't remove the spaces
<Vincenz> if I do manually parsetokem(stream) ...spaces(stream)...parsetoken(stream)...I get the expected result
Vincenz has quit [Read error: 104 (Connection reset by peer)]
mrvn_ has joined #ocaml
mrvn has quit [Killed (NickServ (Ghost: mrvn_!mrvn@p508356B9.dip.t-dialin.net))]
mrvn_ is now known as mrvn
xtrm has quit ["bye bye"]
TachYon has joined #ocaml
systems has joined #ocaml
TachYon has quit ["Client Exiting"]
systems has left #ocaml []
skylan has quit [Read error: 104 (Connection reset by peer)]
skylan has joined #ocaml
TachYon has joined #ocaml
Vincenz has joined #ocaml
<Vincenz> hi!
<Riastradh> Hi!
<Vincenz> oh, hi Riastradh
<Vincenz> could you help me with a bit of syntax?
<Vincenz> mind if I paste?
<Vincenz> let rec integer n = parser
<Vincenz> [< ''0'..'9' as c; r = (integer (10*n + int_of_digit c)) >] -> r
<Vincenz> | [< >] -> n;;
<Vincenz> let rec identifier name = parser
<Vincenz> [< ''a'..'z'|'A'..'Z' as c; r = (identifier (c::name)) >] -> r
<Vincenz> | [< >] -> name;;
<Vincenz> right?
<Vincenz> and then...
<Vincenz> let rec parsetoken = parser
<Vincenz> [< ''0'..'9' as c; r = (integer (int_of_digit c)); spaces >] -> INT r
<Vincenz> | [< ''a'..'z'|'A'..'Z' as c; r = (identifier [c]); spaces >] -> IDENT (implode(r))
<Vincenz> | [< >] -> INT 0;;
<Vincenz> well the problem is...
<Vincenz> if I make a stream with "abc 123"
<Vincenz> and I do parsetoken, i get an IDENT "abc"
<Vincenz> but if I parsetoken again I get int 0
<Vincenz> if id to spaces manually
<Vincenz> and then parsetoken
<Vincenz> I get INT 123
<Vincenz> why doesn't the spaces thing work?
<Riastradh> Er, I don't know how 'parser' works.
<Vincenz> oh, alright :/
<Vincenz> it's camlp4
<Vincenz> problem is, the part on streams and parsers is VERY shrot
<Vincenz> then they go into this whole class-based system
<Vincenz> and sinec I don't know jack of ocaml
<Vincenz> I thought I'd do it the classless way first
* Vincenz wishes someone ould help him
<Riastradh> You don't know jack of OCaml, yet you somehow find it your favourite language?
<whee> heh
mellum has quit [Read error: 110 (Connection timed out)]
<Vincenz> Riastradh: heh...
<Vincenz> Love at first sight?
<Vincenz> but then again, I'm fickle
palomer has quit [Remote closed the connection]
Kinners has joined #ocaml
<whee> heh
<whee> Vincenz: I never got around to answering your erlang question; it's basically a language that emphasizes concurrency (it's also functional)
<whee> it's a lot of fun
<Vincenz> alright
<Vincenz> syntactic-wise, what does it feel like?
<whee> syntax started as a prolog variant, but I have some code somewhere, hold on
<whee> the udp one was just an example of how to use udp, heh
<whee> the fun part about erlang is the hot-swapping of code; I wish every language had it so easy D:
<Vincenz> whee: do you know ocaml?
<whee> of course :P
<Vincenz> hmm, it looks a bit like smalltalk
<Vincenz> scroll up , could you help me?
<whee> playing with parsers?
<Kinners> whee: how's your graphics experiment going?
<whee> Kinners: I did most of the framework, but got bogged down with school
<Vincenz> whee: yup :)
<whee> what are you trying to do Vincenz D:
<Vincenz> create a parser of course :)
<Vincenz> but the spaces part doesn't work in parsetoken
<Vincenz> it doesn't parse the space
<Vincenz> why?
<Vincenz> if I do it manually, it works
<whee> I think it would ignore whitespace
<Kinners> does ocaml support building shared libraries with the native code generator?
<whee> [< >] is only done on empty stream
<Vincenz> parsetoken(stream), spaces(stream), parsetoken(stream)
<Vincenz> [< ''0'..'9' as c; r = (integer (int_of_digit c)); spaces >] -> INT r
<Vincenz> I parse the spaecs, no?
<whee> well, no
<Vincenz> how so?
<Vincenz> if I do parsetoken on a stream with "abc 123"
<Vincenz> I get IDENT "abc"
<Vincenz> and then INT 0
<whee> they'll be skipped over if you convert a string to a character stream
<Vincenz> no
<Vincenz> if I do...
<Vincenz> parsetoken(stream), spaces(stream), parsetoken(stream)
<Vincenz> on "abc 123"
<Vincenz> I get IDENT "abc" and INT 123
<Vincenz> but if I do it in one run
<Vincenz> like..
<Vincenz> parsetoke(stream), parsetoken(strea)
<Vincenz> it doesn't remove the spaces
<Vincenz> and I only get IDENT "abc"
<Vincenz> never gets past the spaces
<whee> er, hrmf
<Vincenz> | [< ''a'..'z'|'A'..'Z' as c; r = (identifier [c]); spaces >] -> IDENT (implode(r))
<Vincenz> I'd expect that last part to remove spaces?
<Vincenz> I read of another way to do it, but I'm wondering why it won't work
<Vincenz> please tell me, and enlighten me, please?