dark_light changed the topic of #ocaml to: OCaml 3.09.2 available! Archive of Caml Weekly News: http://sardes.inrialpes.fr/~aschmitt/cwn/ | A free book: http://cristal.inria.fr/~remy/cours/appsem/ | Mailing List: http://caml.inria.fr/bin/wilma/caml-list/ | Cookbook: http://pleac.sourceforge.net/
<delamarche> my plan was to write a spike ocaml program and then see all the ways in which i've violated common idioms
<jeremy_c> what's the purpose of ` in front of a type? type hello = `WORLD | `YOU ;; ?
<mikeX> jeremy_c: polymorphic variants, see 'Labels and Variants' in the manual
<jeremy_c> mikeX: thanks, looking now.
<jeremy_c> what is the error actually saying in the above pastie?
<jeremy_c> I want it to return a Server.return type
<mikeX> well you are returning unit
<jeremy_c> mikeX: I don't see how.
Leonidas has left #ocaml []
<mikeX> me neither cause I don't know what Rtemplate does
<jeremy_c> mikeX: Rtemplate is nothing more than a type. server.ml has: type return_type =
<jeremy_c> Rtemplate of string
<jeremy_c> | Rstring of string
<jeremy_c> | Rredirect of string
<jeremy_c> | Rerror of string ;;
<mikeX> then you are calling list_callback someplace where a unit return type is expected
<jeremy_c> mikeX: nope, that's not either.
<jeremy_c> mikeX: if I eliminate lines 5-8, all works fine.
<jeremy_c> I guess something screwy is going on there but I don't see it.
<mikeX> try adding parentheses
<jeremy_c> mikeX: to what?
<mikeX> the ifs
<jeremy_c> mikeX: around the conditions?
<jeremy_c> mikeX: if (req#meth == `POST) then ?
<mikeX> no
<jeremy_c> mikeX: I don't understand where else they would go?
<mikeX> if blah then ( blah; blah ); <- this has to be unit
delamarche has quit []
delamarche has joined #ocaml
delamarche has quit [Client Quit]
<jeremy_c> that works, however, if I remove the var types from add_company, it fails.
<jeremy_c> hm, seems that it's the (req : request) that makes things work.
* jeremy_c thinks OCaml is a bit confused.
<Poopsmith> That's funny, because OCaml said the same thing about you earlier.
bzzbzz has quit ["leaving"]
<jeremy_c> Poopsmith: ha! your funny, it was telling me I was crazy.
<jeremy_c> there is some goofy things going on here though and I am sure it's just something I don't understand.
<jeremy_c> It is very confusing to me though.
<jeremy_c> See that? and the compiler error at the bottom?
<jeremy_c> The compile error goes away and all works in the app as suspected if I simply comment out line #10. What does line 10 have to do with line 12?
<Poopsmith> Let me look. I'll see if I can help you.
<Poopsmith> Don't know, offhand. And I'm about to leave work, so no long help time at the moment. Sorry.
<Poopsmith> It's obviously a type error.
<Poopsmith> But...
<jeremy_c> Poopsmith: thanks for taking a peek
<Poopsmith> Sorry. Leaving now. Bye.
idiotequa has joined #ocaml
idiotequa has quit [Client Quit]
idiotequa has joined #ocaml
<idiotequa> So this is the OCaml room eh?
<idiotequa> Wow lots of people
<idiotequa> goto #sex
<idiotequa> ^
<idiotequa> ...
<idiotequa> :(
<idiotequa> I was joking
<idiotequa> Bored..
<idiotequa> oh well
<idiotequa> I'm new to mIRC if anyone couldn't notice already
<levi_home> jeremy_c: You figure it out yet?
<idiotequa> Anyone work with OCaml calculators?
<levi_home> jeremy_c: Your hashtable is expecting a list of tvalues, but you are trying to add a single tvalue that contains a list.
<levi_home> OCaml calculators?
<idiotequa> a Calc.ml program
<idiotequa> that uses .mll form
<idiotequa> and .mly form
mikeX has quit ["zzzz"]
<levi_home> Like the one in the manual?
<idiotequa> yes
<idiotequa> I guess that's where my professor got it from
<idiotequa> it was premade
<idiotequa> and we added the exponentiation function
<levi_home> I read through the code, but I didn't do anything else with it.
<idiotequa> Are there any other IDEs besides Camelia?
<dan2> emacs
<dan2> I've always used emacs for coding ocaml
<dan2> it's the damn best
<jeremy_c> levi_home: thank you. It works now. Just when things are going smooth, when I fix problems of my own, I think I am getting somewhere, then something like this pops up and confuses me making me think I have not learned a thing. Guess it's going to take time :-)
batdog|gone is now known as batdog
<idiotequa> anyone here in college?
whatthedeuce has joined #ocaml
pango_ has joined #ocaml
<whatthedeuce> Hey. I'm trying to do some OpenGl programming in OCaml (using the LablGL interface to OpenGL), but when I try to run the example programs, it says that I do not have Togl and Tk. I have Tcl and Tk installed, and the LablGL website said that LablTk is included with LablGL. How could I fix this?
DRMacIve1 has joined #ocaml
DRMacIver has quit [Read error: 104 (Connection reset by peer)]
pango has quit [Remote closed the connection]
idiotequa has quit []
batdog is now known as batdog|gone
Smerdyakov has quit ["Leaving"]
postalchri1 has quit [Read error: 110 (Connection timed out)]
triple_ has joined #ocaml
whatthedeuce has quit ["Goodbye"]
<jeremy_c> Is there a strftime function for ocaml?
triple_ has quit [Read error: 113 (No route to host)]
<flux__> hm, I think maybe not, I faintly recall myself using printf for that
<jeremy_c> type finder_func = (int option -> 'a) ;;
<jeremy_c> why doesn't that work/how can I make it work?
<flux__> type 'a finder etc
<jeremy_c> type db_connection = Some of Pg.connection | None
<jeremy_c> let db_con db_connection = ref None
<jeremy_c> What about that one? The ref is where I'm having probs.
<pango_> type db_connection = Pg.connection option (otherwise you're shadowing existing Some and None constructors)
<jeremy_c> what about the ref?
<pango_> that line looks ok, the problem, if any, must be elsewhere...
<jeremy_c> let get_connection _ = match !db_con with
<jeremy_c> | Some x -> x
<jeremy_c> | None -> failwith "Not connected"
<jeremy_c> This expression has type 'a -> 'b option ref but is here used with type
<jeremy_c> 'c ref
<pango_> oh, I didn't notice the space between db_con and db_connection
<pango_> let db_con db_connection = ref None <- guess you forget ':'
<pango_> s/forget/forgot/
<pango_> let db_con : db_connection ref = ref None
<jeremy_c> pango_: ah! It was the ref = ref part... I didn't have the 1st ref.
<jeremy_c> well, and the : :-)
<pango_> or let db_con = ref (None : db_connection) I think that should work too
<pango_> btw, in let db_con : db_connection ref = ref None the two refs are different; one is a type, the other is a function
<jeremy_c> Ok, that makes sense w/what I was seeing. = ref is the func db_connection ref is the type
<pango_> yes
<pango_> # ref ;;
<pango_> - : 'a -> 'a ref = <fun>
Ballin_105 has quit ["Konversation terminated!"]
pango_ has quit ["brb"]
slipstream has joined #ocaml
slipstream-- has quit [Read error: 104 (Connection reset by peer)]
<jeremy_c> on let get ?(conv ........
<jeremy_c> type is: val get : ?conv:('a -> 'a) -> 'a -> 'a = <fun>
<jeremy_c> I want it to be val get : ?conv('a -> 'b) -> 'a -> 'b = <fun>
DRMacIve1 is now known as DRMacIver
<jeremy_c> Is it impossible to do?
<jeremy_c> hm,
<flux__> yes
<jeremy_c> let get f a = f a ;; works fine.
<flux__> (impossible)
<jeremy_c> but if I make f optional, it becomes impossible :-/
<flux__> it's the optional argument with a default value that breaks it
<jeremy_c> that's a bummer.
pango has joined #ocaml
david_koontz has quit [Read error: 110 (Connection timed out)]
smimou has joined #ocaml
Ballin_105 has joined #ocaml
ramkrsna has quit [Read error: 110 (Connection timed out)]
ramkrsna has joined #ocaml
zmdkrbou_ is now known as zmdkrbou
bzzbzz has joined #ocaml
_JusSx_ has joined #ocaml
chessguy has joined #ocaml
<jeremy_c> I am thinking about my whole method of db programming. Coming from Java, Ruby I am use to table centric classes but I'm wondering if that's the best way, what about view/action centric queries? Anyone have design paradigm docs? links? discussions? With OO mapping the focus is big time table centric, I'm not convinced that's the best way.
Schmurtz has joined #ocaml
<ulfdoz> The number of opinions is probably as big as the number of "best methods".
<jeremy_c> ulfdoz: I was just thinking of of my RoR's experiences, @people = People.find_all() ... That returns classes fully populated w/10 fields to where I am just using it to populate a select box, id, name that's it. It certainly is easier but that's due to the interface, I wonder if an interface can be built making it just as easy to deal with just id,name in that case.
batdog|gone is now known as batdog
<ulfdoz> Only with an interface to tune the query. In java you would probably use jdbc or the like and populate a bean. btw. I hate beans in Java. A map is better and typesafe.
<jeremy_c> You can @people = People.find_all(:select => 'id,name') but not many apps I see does it, and it also leaves your classes very vulnerable to programming errors, such as def age = now - self.dob end ... that'll fail on a limited select, but it'll let you try.
<ulfdoz> Some kind of prepared statement there?
Leonidas has joined #ocaml
Schmurtz has quit ["L'énergie semble manquer : dodo !"]
batdog is now known as batdog|gone
Smerdyakov has joined #ocaml
batdog|gone is now known as batdog
<jeremy_c> Smerdyakov: I believe we've talked before about using databases. I am debating between following the model found in languages such as Java and Ruby with a class per table with get/set methods vs a generic module for doing specific db queries. What's your input? I may have you confused with another, but our conversation was a long time ago (*I think*)
<jeremy_c> If I remember you had some good thoughts, but I was not quite to the point of developing my db skills in ocaml at the time.
<Smerdyakov> I perhaps pointed you to: http://laconic.sf.net/demo/
<jeremy_c> Smerdyakov: I don't remember seeing that but it's interesting.
<jeremy_c> not sure if I want to start on a new language though...
<jeremy_c> well, actually, certain I don't :-/
<Smerdyakov> That expresses what I think is the right way to do database interaction programmatically. (Regardless of whether you want to use a new language)
Demitar_ has joined #ocaml
Demitar has quit [Read error: 110 (Connection timed out)]
chessguy has quit [" HydraIRC -> http://www.hydrairc.com <- 100,000+ downloads can't be wrong"]
ziggurat has joined #ocaml
<jeremy_c> That's my little working example. Not sure yet.
<Smerdyakov> Looks like a bad interface. I claim that you want to use SQL directly, not _any_ interface on top of it.
<Smerdyakov> The issue is then just cross-language communication and integration.
<jeremy_c> Smerdyakov: seems like there is a lot of background work that would be repeated?
<jeremy_c> Smerdyakov: when you say use SQL directly, are you speaking of issuing SQL statements, for instance, Sql.find_many "SELECT * FROM people WHERE naem LIKE 'John%'" instead of what I have? Or the whole thing, like Sql.get p "first" is bad?
<Smerdyakov> UPDATE People SET first = 'Jeff', age = 10 WHERE name LIKE 'John%'
<jeremy_c> Sql.save automatically determines if it needs INSERT or Update. string_to_sql, int_to_sql will auto escape, insert NULL if necessary, etc...
<Smerdyakov> I claim that the first feature isn't important in practice, and the second set of them are just assumed in any decent interface.
<jeremy_c> Only saves changed values also. So if you query 10 fields, and change 1, you only get UPDATE people SET first='Jeff' ...
<Smerdyakov> (Including mine)
<Smerdyakov> Laconic/Web has no string interface to SQL queries, so there isn't even a _concept_ of "escaping" that you could "forget."
<jeremy_c> Smerdyakov: yeah, I saw. Because of your data definition, it's smart.
<jeremy_c> knowing when to escape and when not to.
<jeremy_c> Smerdyakov: how do you deal with say: SELECT flight_log.from, flight_log.to, flight_log.duration, motor.name, wing.name FROM flight_log, motor, wing WHERE flight_log.motor_id=motor.id AND flight_log.wing_id=wing.id ?
<Smerdyakov> No, there is NO CONCEPT of "escaping"! It's a compiler detail.
<jeremy_c> That's the problem I have with the table defs.
<Smerdyakov> I don't understand what difficulty your question is meant to convey.
<jeremy_c> Smerdyakov: compiler? It knows how to escape a string for a SQL? Mc'Cain has to be translated to Mc''Cain somehow.
<Smerdyakov> A string interface to an SQL server is only _one_possible_implementation_technique_ in the compiler backend.
<jeremy_c> Smerdyakov: I am speaking of the table definitions in your interface.
<Smerdyakov> In fact, my implementation uses prepared statements and binary data specification, so there truly _is_ no escaping _anywhere_.
<jeremy_c> Smerdyakov: hm, I guess I'm not advanced enough to know how to accomplish that task.
<Smerdyakov> jeremy_c, I still don't understand your question. How to handle that SQL query is obvious.
<jeremy_c> Smerdyakov: I think you and I are on different levels, you are obviously far more capable than I am able to understand.
<Smerdyakov> OK, I will try to walk through answering your question.
<Smerdyakov> Your Question: How to handle this SQL query: SELECT flight_log.from, flight_log.to, flight_log.duration, motor.name, wing.name FROM flight_log, motor, wing WHERE flight_log.motor_id=motor.id AND flight_log.wing_id=wing.id
<Smerdyakov> My Answer: Send the query to the SQL server and retrieve the results.
<Smerdyakov> That's it.
<jeremy_c> Smerdyakov: in your person.lac file, you create dbtable defs defining exactly what's going to come back.
<Smerdyakov> My reading of the query leads me to believe that there are no "variables" to be filled in, and constant queries are easy to handle.
<Smerdyakov> Yes, just like you always do with SQL.
chessguy has joined #ocaml
<jeremy_c> Ah, I see. you map the results each time. (fn row : {@flight_log.from : string, @flight_log.to : string, @flight_log.duration : integer} => xxxyyy
<Smerdyakov> That type annotation _is_not_ used to determine what result type is expected.
<Smerdyakov> The table definition determines that.
beschmi has joined #ocaml
<jeremy_c> Is it impossible for a function to return possibly any of bool, char, int, float, string?
<Smerdyakov> Every function has a return type and may only return values in that type.
<jeremy_c> Smerdyakov: how does let dumb a = a work?
<Smerdyakov> The function takes an additional type argument that is usually inferred for you at uses.
<Smerdyakov> (Alterate answer: RTFM. ;-)
_JusSx_ has quit [Client Quit]
ruben17 has joined #ocaml
Schmurtz has joined #ocaml
ruben17 has quit ["Leaving"]
delamarche has joined #ocaml
<dan2> Smerdyakov: what do you think is the greatest ocaml function?
<dan2> in the standard lib
<Smerdyakov> Ill-defined question
<dan2> Smerdyakov: the most powerful, and most useful
<Smerdyakov> Both ill-defined.
<dan2> bleh
<dan2> I don't think there is any thing quite as good as List.map
<dan2> it's the most heavily used function in my latest project
Smerdyakov has quit ["BRB.. reboot"]
Smerdyakov has joined #ocaml
<delamarche> So, i remember when all i knew was C++ and java, and I first started to learn perl... that feeling of "oh my god, I can do so many more things so much faster now that I know perl". (Let's not discuss hindsight at this point.)
pango has quit ["Leaving"]
<delamarche> I'm starting to get that feeling again, learning ocaml
pango has joined #ocaml
ulfdoz_ has joined #ocaml
ulfdoz has quit [Remote closed the connection]
Vadim_offlin has joined #ocaml
<Vadim_offlin> hi guys
Vadim_offlin is now known as vadimtk
luca83 has quit [Read error: 110 (Connection timed out)]
luca83 has joined #ocaml
chessguy has quit [" HydraIRC -> http://www.hydrairc.com <- IRC for those that like to be different"]
chessguy has joined #ocaml
ruben17 has joined #ocaml
<ruben17> I have a very annoying problem: sometimes when i'm in the interactive toplevel the function string_of_char exists, sometimes not. How is this possible?
<Smerdyakov> Do you have an example of when it "doesn't exist"?
<ruben17> # string_of_char;;
<ruben17> Unbound value string_of_char
<ruben17> And I am sure I have been able to use it before
<pango> ruben17: do you mean the function by that name in extlib ?
<Smerdyakov> It's not in Pervasives, so you must have opened a module that has it in the past.
<ruben17> hmm
<ruben17> Well is there a String method that can create a list of characters from a string and the other way around?
<ruben17> then i don't need string_of_char
<Smerdyakov> String is a module, so it doesn't have methdos.
<Smerdyakov> methods
<ruben17> well i didn't know how to call them
<Smerdyakov> Function
<ruben17> ok
<ruben17> so is there a function that does that?
<pango> not in standard library
<ruben17> ok I made them myself using String.make 1
<pango> then catenating those strings ?
<ruben17> yes
<ruben17> is there a better way?
<ruben17> hmm that will probably be better
<ruben17> I did the list_of_string function in imperative style so it should be the same I guess
<ruben17> but my string_of_list should be much slower than yours
<ruben17> thanks
<pango> I think you should also have a look at the Buffer module
<ruben17> later perhaps, i just needed these two functions to get to work
<ruben17> its for the lexical tree exercise in "Developing Applications with Objective Caml"
<ruben17> not a homework assignment, i'm learning it purely out of interest
<pango> ic
<luca83> ruben17: I'm doing those too
<luca83> ruben17: but I haven't completed them
<ruben17> I'm a lot further in the book, but later on there is an exercise for which you need the same lexical tree implementation
<ruben17> So far I really like OCaml
<luca83> I do too :)
* luca83 is going to have his dinner
jeremy_c has quit [Read error: 110 (Connection timed out)]
<pango> ruben17: thinking of it, first function doesn't need to be that large: http://nopaste.tshw.de/1159041290044aa/
<ruben17> ok thanks
<ruben17> does that buffer resize when needed?
<pango> yes, that's the point of buffers
<ruben17> shouldn't it be (List.length cl) then?
<pango> no
<pango> you could do that, but that's unnecessary (and would require a second scan of the list)
<ruben17> but resizing takes time too
<pango> buffers resize exponentially
<ruben17> oh right
<pango> so I'd bet cost is lower that way
<ruben17> I suppose so
ruben17 has quit ["Leaving"]
<luca83> one cannote use List.fold_right?
<luca83> cannot
<pango> (there's another "hidden cost" when using Buffers however... Buffer.contents require an additional copy...)
<pango> luca83: do to what ?
<luca83> pango: to do string_of_char_list etc.
<pango> strings are not extensible, so maintaining string accumulators require lots of allocations and copies
<pango> (if that's what you had in mind)
<luca83> pango: yes,...
<luca83> I don't know well imperative structures
<pango> ocaml strings are not purely functional either, they're not immutable
beschmi has quit ["Leaving"]
<luca83> pango: I did'nt know that ;)
postalchris has joined #ocaml
<Smerdyakov> SML strings are. ;)
<dan2> pango: they're not?
<pango> # let x = "Hello" in x.[1] <- 'a'; x ;;
<pango> - : string = "Hallo"
<dan2> whoa
<dan2> pango: even if they remain mutable by default, someone should email the ocaml team and add a key word immu
<pango> see the mailing list, it has already been discussed, not so long ago
<dan2> pango: and?
<pango> I don't think it's going to happen
<dan2> doh
<dan2> I don't think I ever mutate strings
<Smerdyakov> Use SML if you want a principled language. ;)
<dan2> pango: heh, Gstring
<dan2> SML blows
<Smerdyakov> dan2, why?
<dan2> it doesn't have the decent C binding interface provided by SWIG and Camlidl
<Smerdyakov> Have you ever used MLton's FFI?
<dan2> no
<Smerdyakov> It's way simpler than anything OCaml has.
<dan2> SWIG is pretty damn simple
<Smerdyakov> And the NLFFI that's part of SML/NJ and MLton allows static checking of uses of C code from SML.
<Smerdyakov> How to call a C function from MLton:
<Smerdyakov> val f = _import "f" : unit -> unit; val _ = f ()
<dan2> Smerdyakov: ok, so how about object oriented programming?
<Smerdyakov> Not something I care about
<dan2> Smerdyakov: how about xml processing libraries
<Smerdyakov> Beats me. That's definitely not a language property, though.
<dan2> true
<dan2> I use the ocaml gdome bindings
<dan2> they work great
<dan2> Smerdyakov: I know I like the Concurrent ML interface (very nice)
<dan2> a port of his Mailbox to Ocaml would be nice
<dan2> the standard CML interface is already there
<vadimtk> is there library crc32 in Ocaml ?
chessguy has quit [" HydraIRC -> http://www.hydrairc.com <- IRC has never been so good"]
<levi_home> So, I'm experimenting with functors, and I'm trying to figure out how to split things between files.
<levi_home> I'm writing a chess engine, so I modeled the module decomposition on the O'Reilly book game programming example.
Eelis_ has joined #ocaml
<levi_home> So I've got an eval module signature, a representation signature, and an alphabeta search signature.
Eelis has quit [Nick collision from services.]
Eelis_ is now known as Eelis
<levi_home> I'm not sure what to put in .ml files and what in .mli files
<levi_home> Or what the files need to be named, since that seems to be significant.
<Smerdyakov> .mli files specify the externally visible interfaces of .ml files.
<Smerdyakov> (If the book doesn't make that clear, then something is wrong with it!)
<levi_home> Right, I got that.
<Smerdyakov> So what is your confusion re: filenames?
<levi_home> What about functors, though? A given functor may be used to define the interface for several .ml files, no?
<Smerdyakov> No. Functors don't define interfaces.
<levi_home> Doesn't an application of a functor define an interface?
<Smerdyakov> No. A functor is like a function, not a type.
<luca83> One question :)
<Smerdyakov> But let's try to use the real terminology.
<Smerdyakov> We have modules and module types.
<Smerdyakov> .ml/.mli are a stupid reimplementation of the same concepts at a fixed level.
<Smerdyakov> .ml files are modules, while .mli files are _almost_ module types.
<luca83> How can I write a parser for an XML document type? What tools/libraries are available for OCaml?
<levi_home> Smerdyakov: Okay, that makes sense.
<luca83> (I've looked for this but it doesn't seem so easy...)
<levi_home> So, when I apply a functor, I am creating a module, not a module type, correct?
<vadimtk> luca83 I'm using xml-light for start
<luca83> I'm going to see what it is, thanks...
<Smerdyakov> levi_home, yes. Try reading the OCaml manual's tutorial if that wasn't clear from the book.
<levi_home> This separate compilation stuff seems far more complex than it needs to be in the presence of functors and module types.
<Smerdyakov> How so?
<levi_home> Well, according to the manual, '... only top-level structures can be mapped to separately-compiled files, but not functors nor module types. However, all module-class objects can appear as components of a structure, so the solution is to put the functor or module type inside a structure'
<Smerdyakov> Yup. See SML for a cleaner solution.
<levi_home> I was tempted to do this in SML instead, but I figured I'd already done a similar program in OCaml, so I'd stick with it.
<delamarche> does anyone know of a good discussion about when one should use objects vs. functional style in ocaml? (Perhaps from the ocaml-beginners archive or something?)
shekmalhen has joined #ocaml
<levi_home> Hmm, okay, I've got separate compilation working now. Thanks, Smerdyakov.
<delamarche> nvm there's a good discussion in "developing applications..."
<pango> delamarche: see also the "free book" link in the topic
<delamarche> thanks pango!
vadimtk has quit [Read error: 110 (Connection timed out)]
<delamarche> hmmm i like the discussion in the o'reilly book a bit better though
chessguy has joined #ocaml
delamarche has quit []
<Ballin_105> almost got my system up and going
smimou has quit ["bli"]
luca83 is now known as aaaluca
joshcryer has quit [Client Quit]
Leonidas has quit ["An ideal world is left as an exercise to the reader"]