mbishop changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | Grab OCaml 3.10.2 from http://caml.inria.fr/ocaml/release.html (featuring new camlp4 and more!)
<palomer> is {<a=b>} special syntactic sugar?
<mbishop> teehee, ruby software
l_a_m has quit [Remote closed the connection]
middayc has joined #ocaml
Anarchos has quit ["Vision[0.8.5-0418]: i've been blurred!"]
coucou747 has quit [Remote closed the connection]
yangsx has joined #ocaml
mwc has joined #ocaml
postalchris has quit [Read error: 110 (Connection timed out)]
postalchris has joined #ocaml
evn has quit []
evn has joined #ocaml
dobblego has joined #ocaml
postalchris has quit [Read error: 110 (Connection timed out)]
* palomer notices that objects/modules/records all seem like variations on a theme
<palomer> is it possible to open a module in an unqualified fashion (ie, don't need to put M. everywhere)
<Smerdyakov> palomer, maybe you should read this book before proceeding: http://files.metaprl.org/doc/ocaml-book.pdf
<palomer> everyone keeps recommending a different book!
postalchris has joined #ocaml
<palomer> ahh, that book looks good
<palomer> it seems that every file has a toplevel module implicitly specified, what if I want it to be a functor instead of a module?
<Smerdyakov> Not possible in OCaml
<palomer> does this bother anyone? or is it a petty detail?
seafood_ has joined #ocaml
evn_ has joined #ocaml
psnively has quit []
evn_ has quit []
seafood_ has quit []
<palomer> is there a default exception to raise?
<thermoplyae> Failure, maybe
<neale> that wouldn't really work with the typing system now would it
<palomer> gotcha
<thermoplyae> what about the typing system?
<neale> raise : exn -> 'a
<neale> so it takes an exception and returns anything (actually it never returns)
<palomer> hrmph
<palomer> is there anyone close to haskell's $ operator in ocaml?
<neale> for it to take a default it'd have to be something like
<neale> raise : ?(exception : exn) -> unit -> 'a
<thermoplyae> how about 'let ($) x y = x y'
<thermoplyae> i don't recall haskell's $'s associativity, so that might not be exactly it, but
<palomer> that defines an infix $?
<thermoplyae> it sure does
<neale> what is $, function composition?
<thermoplyae> looks like it's left-associative
<palomer> $ is right associative
<thermoplyae> although hmm, the point of $ is precedence, which i also have no idea about
<palomer> no wait
<thermoplyae> it's somewhere buried in the ocaml user manual, you can tailor it to some extent
<neale> I think rather than trying to make OCaml look like Haskell, you'd be better served by using parens.
<palomer> but I like writing foo $ bar $ sash $ goobies
<palomer> instead of foo (bar (sash (goobies)))
<neale> well perhaps you should use Haskell :)
<neale> as an OCaml programmer, seeing "foo $ bar $ sash $ goobies" in someone's program would baffle me.
<palomer> but I can also write it in ocaml
<palomer> so why not?
<neale> if you wanted to you could say
<neale> let snork = true; let bleet = false
<neale> but I don't think that would really serve to make yourcode any clearer
<neale> I mean if you're just playing around with the language, sure, go for it
<neale> but don't start coding that way for real :)
<palomer> if, in my language, snork means true and bleet means false, and I'll be the only one working on my language, then it's fine
<palomer> if others are going to edit my program, then I'll make it clear in the documentation
<neale> and if you ever want to get a job you might want to consider not doing it at all :)
<pango> F# uses |< and |>, it's not that bad (and quite intuitive to shell users ;) )
<pango> # let ( |< ) f x = f x ;; # let ( |> ) f x = x f ;;
<palomer> pango, cool!
<neale> palomer: for a good example of the sort of coding practice you're talking about, have a look at the source code for lsh. It's all standard C.
<palomer> anyways, let's just agree to disagree
<palomer> in an agreeable fashion
<pango> mmmh actually it should be let ( |> ) x f = f x (not that it matters to the compiler :) )
middayc has quit []
authentic has quit [Read error: 104 (Connection reset by peer)]
authentic has joined #ocaml
authentic has quit [Read error: 104 (Connection reset by peer)]
authentic has joined #ocaml
thelema has quit [Read error: 110 (Connection timed out)]
postalchris has quit [Read error: 110 (Connection timed out)]
* palomer thinks he needs to see some real ocaml code
seafood_ has joined #ocaml
<palomer> anyone have some real ocaml code to show me?
__suri_ has joined #ocaml
__suri has quit [Read error: 110 (Connection timed out)]
<palomer> how do I load a file into the interpreter?
<thermoplyae> #use or #load, depending upon whether it's compiled
evn_ has joined #ocaml
thelema has joined #ocaml
<palomer> thx
<palomer> http://ocaml.pastebin.com/m3c268867 <---this function inserts a string at each occurence of a character
<palomer> it looks really, really ugly
<palomer> anyone have a better solution?
<thelema> palomer: it blits - it doesn't insert.
<thelema> I can write a version that inserts efficiently, but it's much more complex.
<thelema> I guess you could reorganize it into a String.iteri function and the action to do at each location.
<thelema> palomer: but other than hoisting the (String.length to_insert) out of the loop, and writing str.[i] instead of String.get str i
<thelema> also, "else ()" can be elided in ocaml.
<palomer> hrmph
<palomer> I don't care about efficiency
<thelema> do you care about the difference between blitting and inserting?
<palomer> to tell you the truth
<palomer> I don't know what blitting means
<palomer> String.blit src srcoff dst dstoff len copies len characters from string src, starting at character number srcoff, to string dst, starting at character number dstoff. It works correctly even if src and dst are the same string, and the source and destination chunks overlap. Raise Invalid_argument if srcoff and len do not designate a valid substring of src, or if dstoff and len do not designate a valid substring of dst.
<palomer> I'm guessing that it doesn't change the length of the string
<thelema> exactly. it overwrites a slice of the string.
<palomer> looking at the String module
<palomer> there best way is to take the substring on either side
<palomer> and then use ^
<palomer> what's iteri?
<palomer> can't find it in the module
<thelema> it doesn't exist in String, only Array
<palomer> a string is an array?
coucou747 has joined #ocaml
<thelema> no, they're different.
<palomer> oh
<thelema> but almost the same code would implement String.iteri
<thelema> Arrays always have 32/64-bit entries. Strings always have 8-bit entries.
<thelema> err, arrays are word-indexed, strings are byte indexed.
<thelema> There's some code here that might come in handy: nsplit especially
<palomer> cool!
<thelema> let insert_after str c insert = String.concat insert (String.nsplit str (String.of_char c))
<palomer> thelema, yeah, that's a cool way too
<palomer> that IS a useful function
<thelema> if you don't care about efficiency, your way works. Using ^ a lot results in *lots* of copying
<thelema> every ^ allocates a new string.
<palomer> where does your List.cons come in?
<palomer> ocaml can't find it
<palomer> let explode string =
<palomer> fold_right List.cons string []
<palomer> let explode string =
<palomer> let cons a b = a :: b in
<palomer> fold_right cons string []
bluestorm_ has quit ["Konversation terminated!"]
<thelema> Improved version of List too.
<thelema> let cons h t = h :: t
<palomer> have you submitted this code to the ocaml people?
<thelema> they don't really take extensions to the stdlib - they don't have enough people at INRIA to maintain it.
<thelema> most of the code comes from existing extensions to the ocaml stdlib - ExtLib, AnnexLib, MissingLib, stdlib2, ...
mwc has quit [Remote closed the connection]
<palomer> nsplit exists in extlib?
<thelema> yes
<palomer> ahh
<palomer> Unbound value ExtString.nsplit
<thelema> open ExtString
<palomer> Unbound module ExtString
<palomer> is ExtString UTF8 compatible?
<thelema> It can hold UTF8 strings, but doesn't do any special processing...
<thelema> I'm working on a proper UTF8 string library using ropes
<palomer> is ExtString compatible with string?
<palomer> I'd like to use it with lablgtk
<thelema> yes.
<palomer> okay
<palomer> libextlib-ocaml-dev is already the newest version.
<palomer> hmm
mwc has joined #ocaml
<palomer> how do I add the library in my commandline?
<thelema> findlib?
<palomer> err, my compile command
<palomer> findlib?
<palomer> proper utf8 would be cool!
<thelema> palomer: It's harder than it sounds.
<thelema> ocamlc -I /path/to/extlib extLib.cma program.ml
<palomer> shouldn't it automatically be in my include path?
<thelema> If ocaml was nicer, yes. I don't think it is automatically.
<palomer> Unbound value nsplit (it opens the module ok, but then can't find nsplit)
<thelema> ocamlfind ocamlc -package extLib myprog.ml
<thelema> nsplit still needs to be called String.nsplit
<thelema> even after you [open ExtString]
<palomer> ahh
<palomer> got it
<coucou747> @+
coucou747 has quit ["bye ca veut dire tchao en anglais"]
mwc has left #ocaml []
evn_ has quit []
ttamttam has joined #ocaml
l_a_m has joined #ocaml
thermoplyae has quit ["more homotopy tomorrow"]
Demitar has quit [Remote closed the connection]
Demitar has joined #ocaml
Snark has joined #ocaml
aminore1 has quit [Read error: 104 (Connection reset by peer)]
m3ga has joined #ocaml
schme has joined #ocaml
yangsx has quit [Read error: 110 (Connection timed out)]
hkBst has joined #ocaml
goalieca has quit [Remote closed the connection]
jlouis has joined #ocaml
Demitar has quit [Read error: 110 (Connection timed out)]
Yoric[DT] has joined #ocaml
jlouis_ has joined #ocaml
gene9 has joined #ocaml
<gene9> Is it possible to use types declared in modules in external functions. I tried to explain what I need here: http://pastebin.com/mbd5a858
jlouis has quit [Read error: 110 (Connection timed out)]
<jlouis_> gene9: your problem is that t is abstract outside the module.
<jlouis_> suppose I came up with module Y : Z = struct type t = int end;;. Then my code should work equally well when evaluating fn(10.2) which it obviously doesn't
<gene9> hmm, I see
<jlouis_> You have several options battling the problem, but the correct one depends on the context and your goals, in general: http://caml.inria.fr/pub/docs/manual-ocaml/manual004.html
<gene9> jlouis_: thank, I already studied this manual chapter, but stuck, I will try to read it more carefully
gene9 has quit ["leaving"]
m3ga has quit ["disappearing into the sunset"]
coucou747 has joined #ocaml
Snark has quit ["Ex-Chat"]
schme has quit ["bfirc sucks."]
Anarchos has joined #ocaml
<Yoric[DT]> Does anyone know if there's an introductory-level semantics of Caml available around the net ?
<Yoric[DT]> (I'm willing to take Caml-Light, I just need the basics)
<Anarchos> yes
<Anarchos> wait a minute
<Yoric[DT]> It's for an introductory-level lecture on algorithmic complexity.
postalchris has joined #ocaml
<Anarchos> or look at the introductory section of the official manual
<Smerdyakov> Anarchos, the manual has nothing that deserves to be called "a semantics."
<Yoric[DT]> Mmmhhh....
<Yoric[DT]> Translation to lambda-calculus is probably not what I want.
<Yoric[DT]> Well, I'll pick what I can from u3-ocaml.
<Yoric[DT]> Thanks.
<Smerdyakov> Translation to lambda calculus is the most practical way of giving semantics to functional languages.
<Yoric[DT]> Sure.
<Yoric[DT]> It just happens so that I haven't taught lambda-calculus yet to my students.
<Yoric[DT]> I don't have nearly enough hours to teach them both OCaml, Logics, Algorithmics Complexity *and* Lambda-Calculus.
<Anarchos> Yoric[DT] so you'd better teach complexity in pascal ;)
<Yoric[DT]> :)
<Yoric[DT]> Worse than that, I'm expected to teach Complexity in both OCaml and Java.
<Yoric[DT]> So I can't rely on lambda-calculus alone.
<Anarchos> Yoric[DT] how many semesters have you ??
<jlouis_> If he says .5, I cringe
<Yoric[DT]> They've had 3 terms of Java (as their only course of computer science).
<Yoric[DT]> Now, they've 1 term of OCaml and Logics + Complexity.
<Yoric[DT]> The half-term on Logics is complete.
<Yoric[DT]> They know enough OCaml to program some decent stuff (they've already programmed a Game of Life using OCamlSDL).
<Yoric[DT]> And tomorrow starts the half-term on Complexity.
<Yoric[DT]> To the best of my knowledge, algorithmic complexity doesn't have much in the way of theory (by opposition to computational complexity, which I just can't teach in .5 term), so I intend to complete this by an informal introduction to semantics.
RobertFischer has joined #ocaml
nuncanada has quit [Remote closed the connection]
postalchris has quit [Read error: 110 (Connection timed out)]
Anarchos has quit ["Vision[0.8.5-0418]: i've been blurred!"]
rogo has joined #ocaml
delamarche has joined #ocaml
mikeX has joined #ocaml
<mikeX> hello, does the ML standard enforce tail call optimization?
<Smerdyakov> What does this have to do with OCaml?
<Smerdyakov> OCaml is governed by no standard and doesn't even have a real language definition.
<mikeX> well it doesn't really, I just thought someone here would know this :)
<Smerdyakov> So you're asking about the Definition of Standard ML?
<mikeX> as I said, I just thought someone here would know this :)
<mikeX> you for example
<Smerdyakov> I asked a question, and I can't help you if you don't answer it.
<mikeX> I did answer it, because I thought someone here might know about the Definition of SML
<mikeX> nothing to do with ocaml
<mikeX> (some actually, my next question would be O'Caml's approach to tail call optimization)
<Smerdyakov> You didn't answer my question.
<Smerdyakov> It seems you're implying now that your answer is "yes."
<mikeX> hmm, what was your question then?
<Smerdyakov> <Smerdyakov> So you're asking about the Definition of Standard ML?
<mikeX> well, from a conversational view point
<mikeX> oh, I missed the ? on that line. Yes I am
<mikeX> sorry
<Smerdyakov> I don't think the Definition says anything about implementation. It only specifies semantics.
<mikeX> What about the mlton implementation then
<Smerdyakov> Every real functional language implementation does tail call optimization.
<thelema> TCO helps so much in functional languages that implementors don't forget it.
<mikeX> what about trying to convert non tail-recursive calls to tail-recursive
<Smerdyakov> Hardly any do that.
<Smerdyakov> I couldn't name off the top of my head an implementation that does.
<mikeX> I see, I thought mlton might give that a go
<mikeX> or maybe stalin
<thelema> managing side effects of reordering code... difficult. haskell or another extremely pure language might.
<Smerdyakov> Haskell doesn't count as "extremely pure" in my book.
<Smerdyakov> What does "extremely" add over "pure" that you think Haskell has?
<thelema> you're right, I should have just said "pure"
pango has quit [Remote closed the connection]
psnively has joined #ocaml
johnnowak has joined #ocaml
pango has joined #ocaml
<neale> 23:24 <palomer> http://ocaml.pastebin.com/m3c268867 <---this function inserts a string at each occurence of a character
<neale> use the Buffer module
Morphous has joined #ocaml
ikaros has joined #ocaml
<jlouis_> mikeX: Hardly any implementations do that. And it is not worth the effort. As soon as the profiler has targeted your space-cost-centre, you rewrite it to tail-call form and then the problem is out of the way.
<jlouis_> mikeX: That said, The only implementation of Standard ML which may avoid TCO is Hamlet. Hamlet seeks to in isomorphism with the Definition of SML.
<jlouis_> to be in..
<mikeX> i see, thanks jlouis_
<thelema> neale: I like my version: split the string and use String.concat (which is quite efficient) to join the substrings with the right separator.
Linktim has joined #ocaml
postalchris has joined #ocaml
<thelema> the only way to make it more efficient would be to use (pos,len) pairs for intermediate values (location of what to keep), and then piece the new string together with only one string copy per segment
<thelema> l
ttamttam has left #ocaml []
Amorphous has quit [Connection timed out]
<neale> thelema: oh, yeah, that's good too
<neale> (String.concat)
ikaros has quit ["segfault"]
evn_ has joined #ocaml
evn_ has quit [Read error: 104 (Connection reset by peer)]
evn_ has joined #ocaml
marmottine has joined #ocaml
yminsky_ has joined #ocaml
yminsky has quit [Read error: 104 (Connection reset by peer)]
prince has quit [Nick collision from services.]
prince has joined #ocaml
marmottine has quit [Remote closed the connection]
postalchris has quit [Read error: 110 (Connection timed out)]
marmottine has joined #ocaml
johnnowak has quit []
ita has joined #ocaml
bluestorm has joined #ocaml
ygrek has joined #ocaml
thermoplyae has joined #ocaml
munga has quit ["Leaving"]
evn_ has quit []
jlouis has joined #ocaml
ttamttam has joined #ocaml
postalchris has joined #ocaml
jlouis_ has quit [Read error: 110 (Connection timed out)]
thermoplyae has quit ["daddy's in space"]
ttamttam has left #ocaml []
Linktim has quit [Remote closed the connection]
szell` has joined #ocaml
psnively has quit []
psnively has joined #ocaml
szell has quit [Connection timed out]
bluestorm is now known as bluestorm_aw
rogo has left #ocaml []
gim_ has quit [Read error: 110 (Connection timed out)]
ppsmimram has quit [Read error: 110 (Connection timed out)]
bluestorm_aw is now known as bluestorm
l_a_m has quit [Remote closed the connection]
Anarchos has joined #ocaml
ygrek has quit [Remote closed the connection]
thermoplyae has joined #ocaml
dibblego has quit [Remote closed the connection]
thermoplyae has quit [Read error: 110 (Connection timed out)]
bluestorm has quit ["Konversation terminated!"]
Demitar has joined #ocaml
ita has quit ["Hasta luego!"]
jlouis_ has joined #ocaml
Anarchos has quit ["Vision[0.8.5-0418]: i've been blurred!"]
marmottine has quit [Remote closed the connection]
Yoric[DT] has quit ["Ex-Chat"]
jlouis__ has joined #ocaml
jlouis has quit [Read error: 110 (Connection timed out)]
hkBst has quit ["Konversation terminated!"]