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
graydon has quit [Remote closed the connection]
lament has joined #ocaml
skylan has joined #ocaml
mattam has quit ["zZz"]
rox has quit ["reboot"]
graydon has joined #ocaml
mattam has joined #ocaml
Kinners has quit ["leaving"]
uzdav has joined #ocaml
docelic is now known as docelic|sleepo
<uzdav> can someone help me understand why this code isn't accepted? Suppose I have a list of tuples...
<uzdav> let rec f x = function
<uzdav> [] -> ()
<uzdav> | (a, _) :: tail -> print_string a; f tail;;
<uzdav> Characters 74-80:
<uzdav> | (a, _) :: tail -> print_string a; f tail;;
<uzdav> oops, ignore the last 2 lines.
<uzdav> here's the toplevel output:
<uzdav> # let rec f x = function
<uzdav> [] -> ()
<uzdav> | (a, _) :: tail -> print_string a; f tail;;
<uzdav> Characters 74-80:
<uzdav> | (a, _) :: tail -> print_string a; f tail;;
<uzdav> ^^^^^^
<uzdav> This expression has type (string * 'a) list -> unit
<uzdav> but is here used with type unit
<uzdav> #
<uzdav> isn't "tail" a list of tuples too? Why does it think it's of type unit?
<whee> hooray, something to read
<uzdav> hi
<whee> I believe you don't really want the "x" in the first line
<whee> also, I'm not sure about the pattern matching in general
<whee> wait, nevermine that's fine
<uzdav> Ahh, that's it. Sometimes I guess I overlook the obvious. :)
merriam has quit [calvino.freenode.net irc.freenode.net]
<uzdav> Is there a way to represent a function with an arbitrary number of parameters?
merriam has joined #ocaml
<whee> define arbitrary
<whee> you'd have to use a list if there's really no way of knowing how many parameters there will be
<uzdav> Ok, in my case, 0, 1, 2, or 3
<whee> or you could use optional labelled parameters
<uzdav> I thought about the labels, but don't really like it all that much. I don't have any good default "not present" values.
<uzdav> What I'm trying to do is make an interpreter that permits the user to register callback functions. I'd like to be able to register functions taking up to 3 arguments.
<whee> you might have to define multiple functions, each handling a different number of arguments
<whee> there really should be a nicer way but I can't think of something heh
<uzdav> Currently, I have a type like this: type ('a, 'b) node =
<uzdav> F0 of func_desc * ('a -> 'b)
<uzdav> | F1_precalc of func_desc * ('a -> 'b -> 'b) * ('a, 'b) node
<uzdav> | F2_precalc of func_desc * ('a -> 'b -> 'b -> 'b) * ('a, 'b) node * ('a, 'b) node
<uzdav> | F3_precalc of func_desc * ('a -> 'b -> 'b -> 'b -> 'b) *
<uzdav> ('a, 'b) node * ('a, 'b) node * ('a, 'b) node
<uzdav> | Invalid_
<uzdav> ... (and func_desc is a record describing the function, has a string name of it, the arity, etc.)
<uzdav> Ah, I was simplifying it and forgot to remove "precalc". You can ignore that.
<uzdav> This seems to be working fine, but I have to keep different lists to hold all the different functions, and it'd be nice if they could be stored in one list.
<whee> this may be a job for polymorphic variants
<whee> it might look cleaner, anyway.
<whee> I really haven't done much with polymorphic variants so I'm not sure, though :)
<uzdav> I actually stumbled across them by accident tonight, by reading the docs for Hashtbl, and on the flip-page was Genlex, which had this funny syntax of [< ...], which looked totoally unfamiliar, so I started reading about it. Still don't understand it though. The documentation is extremely scant, and I am not sure I understand what problem it is solving. :)
<uzdav> I'm wondering if objects would be helpful here, and the list is of the "base class"
<uzdav> However, I haven't explored objects in ocaml well enough to feel comfortable using them yet.
<whee> I don't think it's a job for objects
<uzdav> can you think of a way to have one list that stores all the different types of functions?
<whee> you could generalize the type maybe
<whee> F Int ['a], where the Int is the arity
<uzdav> is that the new syntax? :)
<whee> that's me using haskell syntax :)
<uzdav> oh, I'll just open the Haskel module then. <g>
<uzdav> are you French?
<whee> type blah 'a = [ F of int and list 'a ]; <- revised syntax way
<whee> no, not french
<uzdav> oh. Just wondering.
<whee> I can't even figure out how to do this in the standard syntax
<uzdav> What does the F mean in your definition?
<uzdav> nevermind.
<uzdav> here: type 'a blah = F of int * ('a list);;
<uzdav> Naw, that doesn't look right either.
<uzdav> I think this is what I meant : type 'a blah = F of (int * 'a) list;;
<uzdav> Is that right?
<uzdav> here is the toplevel result: type 'a blah = F of (int * 'a) list
mattam has quit ["leaving"]
<whee> what does * do again? tuples?
<whee> you want to end up with a constructor that takes an int and a list of something
<uzdav> that's a simplification, but yes.
<whee> I'm just entirely confused because both haskell and the revised syntax make it look nice and pretty, while standard mixes in some weird looking tuple syntax that I can't remember :)
<uzdav> For example, the "if" function in my "language" would take 3 arguments, the condition, the true body, and the false body. If I were to implement "if" and register it,
<uzdav> I'd want the node to hold a function that takes 3 programs for arguments, and 3 programs that will be those arguments.
<whee> right, so if would be F 3 [condition, true body, false body]
<whee> which probably won't work
<whee> well it should work that way, hrmf
<whee> wait, nevermind
<uzdav> it might be possible, actually.
<uzdav> not exactly as you showed, but close.
<whee> I had an idea and then I forgot it
<whee> ignore the whole arity thing
<uzdav> can it be deduced?
<whee> you can use your func_desc record and a list of arguments couldn't you?
<uzdav> yes, but it also needs the most important thing: the function itself.
<whee> well the func_desc record should contain that
<whee> with the curried nature, you could do folding on the list and build the final function call
<whee> I _think_
Segora has quit [Read error: 110 (Connection timed out)]
<uzdav> I'll play around with this idea. I'm not committed to any solution yet. :)
<uzdav> Can the func_desc record hold different types of functions and still fit into this picture?
<whee> yes
<whee> I'm just trying to think of a way to convert the list into a function
<uzdav> 'a func_desc = { } ?
<whee> func_desc just needs the arity (as a precaution) and the function itself
<whee> do you see what I'm trying to do?
<whee> if you have a function f and a list [1;2;3], applying f (which is int -> int -> int -> bool for example) yields a int -> int ->bool function
<whee> then apply it to the next head(2), yielding int -> bool, then apply to 3, which is the final result
<uzdav> Hmm, that looks like it could work.
<whee> it should be a simple fold
<whee> probably you want to reverse the argument list and fold_left
<uzdav> Not quite as simple as that, because the arguments themselves are "expressions" that need to be evaluated before they're passed in.
<whee> well still you'd just have to parse the expressions either before or during the folding
<whee> but that should work for using a single type constructor for representing any number of functions
<uzdav> Do you think that would be more efficient (at runtime) than having different variant types for each function arity?
<whee> probably not more efficient, but it's certainly cleaner
<whee> kind of.
<uzdav> I'd have to do a pattern match to determine which type of node I'm dealing with, or I'd have to do a fold. I don't have a good feel for efficiency.
<uzdav> But there are actually 7 patterns I'm matching now. Would a fold on a 3-arg list be worse?
<whee> either one is trivial
<whee> I'd go with whatever is easier to maintain and use
<uzdav> Yes, but the problem I'll be working on will take perhaps a weekend or more to run already. I'm hoping for "as efficient as possible" a solution, provided it's clean enough. THis will be the core of the processing.
<uzdav> (Genetic algorithms)
<whee> hrm
<whee> I'd go with the variant solution then
<whee> build an AST, parse it
<uzdav> The simple solution I have now is this (and it's working beautifully, but is far too restrictive):
<uzdav> type 'a node =
<uzdav> If of 'a node * 'a node * 'a node
<uzdav> | While of 'a node * 'a node
<uzdav> | Seq of 'a node * 'a node
<uzdav> | Func of (int * ('a -> int) * string)
<uzdav> | Invalid_
<uzdav> where Func holds the function index, the pointer, and the name. The problem with this is it only works with 1-argument functions, and If, While, and Seq are handled differently than "user provided" functions.
<whee> that one argument could be a tuple, heh
<uzdav> I'm wanting to generalize this solution to allow the user to register a function with up to 3 arguments, and to provide the "standard library" using the exact same kind of registration.
<uzdav> That brings up a question i've had on the back of my mind. Is there a way to extract a value from a tuple without pattern matching?
<whee> fst and snd get the first/second value, I doubt there's more
<uzdav> But those are just functions that do pattern matching. :)
<whee> that's the only way to extract tuple information
<uzdav> ah, ok. I was starting to think that was the case, but just wanted to be sure.
<whee> I'm sure the compiler optimizes the hell out of a pattern match to extract things from tuples
<uzdav> yeah, it's really impressive.
<uzdav> so how long have you been using ocaml?
<whee> year or two or more, can't remember when I first started learning :)
<uzdav> I started in december. :) The online documentation is the only resource I have to learn from, except IRC is proving to be amazingly useful too.
<uzdav> is the O'Reilly book actually going to be published? I see a copyright of 2000 in it...
<whee> I don't know, it's been online for quite a while
<whee> I'm not sure what they're waiting for
<uzdav> I still am finding some French in the book. :)
<uzdav> but it's really quite good nonetheless.
docelic|sleepo is now known as docelic
<uzdav> Well, it's getting pretty late and I need to get up early (as usual). Thanks for your help, once again.
Torquemada has quit [Remote closed the connection]
Torquemada has joined #ocaml
uzdav has quit ["[x]chat"]
asqui has quit [Connection timed out]
mattam has joined #ocaml
asqui has joined #ocaml
asqui has quit [Read error: 60 (Operation timed out)]
asqui has joined #ocaml
lament has quit ["PROSECUTORS WILL BE TRANSGRESSICUTED."]
docelic has quit [calvino.freenode.net irc.freenode.net]
steele has quit [calvino.freenode.net irc.freenode.net]
kev_ has quit [calvino.freenode.net irc.freenode.net]
steele has joined #ocaml
kev has joined #ocaml
docelic has joined #ocaml
mattam has quit [Remote closed the connection]
mattam has joined #ocaml
jao_away has quit ["ERC vVersion 3.0 $Revision: 1.329 $ (IRC client for Emacs)"]
karryall has joined #ocaml
docelic has quit ["Client Exiting"]
asqui has quit [Read error: 60 (Operation timed out)]
__mattam__ has joined #ocaml
Yurik has joined #ocaml
mattam has quit [Read error: 113 (No route to host)]
__mattam__ is now known as mattam
<Yurik> hi all
asqui has joined #ocaml
<Yurik> asqui: hi
mattam has quit [Read error: 113 (No route to host)]
mattam has joined #ocaml
asqui has quit [Connection timed out]
asqui has joined #ocaml
gehel has left #ocaml []
gehel has joined #ocaml
asqui has quit [Connection timed out]
asqui has joined #ocaml
Segora has joined #ocaml
Yurik has quit [Read error: 104 (Connection reset by peer)]
mattam_ has joined #ocaml
esabb has joined #ocaml
Yurik has joined #ocaml
Yurik has quit [Client Quit]
lam has quit ["leaving"]
mrvn_ has joined #ocaml
mattam has quit [Read error: 110 (Connection timed out)]
lam has joined #ocaml
Segora has quit [Remote closed the connection]
mrvn has quit [Read error: 110 (Connection timed out)]
Segora has joined #ocaml
<Segora> re
<sam_> morning
Dalroth has joined #ocaml
rox has joined #ocaml
Dalroth has left #ocaml []
lindril has quit [Read error: 104 (Connection reset by peer)]
lindril has joined #ocaml
docelic has joined #ocaml
graydon has left #ocaml []
my_nick_name_is_ has joined #ocaml
asqui has quit [Read error: 60 (Operation timed out)]
my_nick_name_is_ is now known as asqui
asqui has quit [Excess Flood]
asqui has joined #ocaml
lament has joined #ocaml
rox is now known as rox|nemamevise
sam_ has left #ocaml []
sam_ has joined #ocaml
Qui_Gon has joined #ocaml
<Qui_Gon> hello
<Qui_Gon> somebody has already installed camllight on linux ?
<whee> Qui_Gon: have a problem?
<Qui_Gon> yes i've a pb with libunix and libgraph
<Qui_Gon> i need these 2 lib but i've many error in compiling them
<whee> what kind of errors?
<Qui_Gon> cc -I../../src/runtime -O -c -o accept.o accept.c
<Qui_Gon> In file included from /usr/include/sys/un.h:38,
<Qui_Gon> from socketaddr.h:4,
<Qui_Gon> from accept.c:8:
<Qui_Gon> /usr/include/string.h:257: parse error before `('
<Qui_Gon> /usr/include/string.h:257: conflicting types for `memmove'
<Qui_Gon> /usr/include/string.h:43: previous declaration of `memmove'
<Qui_Gon> /usr/include/string.h:257: parse error before `__const'
<Qui_Gon> make: *** [accept.o] Erreur 1
<whee> that's not good. heh
<Qui_Gon> i have this in compiling libunix
<Qui_Gon> i have tried to comment the line where the error occur
<Qui_Gon> but i've an other kind of pb
<Qui_Gon> camlmktop -o camlunix -custom unix.zo libunix.a
<Qui_Gon> libunix.a(errmsg.o)(.text+0x36): In function `unix_error_message':
<Qui_Gon> : `sys_errlist' is deprecated; use `strerror' or `strerror_r' instead
<Qui_Gon> libunix.a(errmsg.o)(.text+0x1a): In function `unix_error_message':
<Qui_Gon> : `sys_nerr' is deprecated; use `strerror' or `strerror_r' instead
<whee> what happens if you try gcc instead of cc?
<Qui_Gon> where .
<Qui_Gon> ?
<Qui_Gon> same thing
<whee> the first one
<whee> I really don't know what that would be, that's a problem in the system headers
Qui_Gon has quit ["Client Exiting"]
lament has quit ["PROSECUTORS WILL BE TRANSGRESSICUTED."]
docelic has quit [Read error: 60 (Operation timed out)]
docelic has joined #ocaml
foxen5 has joined #ocaml
matkor has joined #ocaml
foxen5 has quit [Read error: 104 (Connection reset by peer)]
foxen5 has joined #ocaml
esabb has left #ocaml []
jao has joined #ocaml
matkor has quit [Remote closed the connection]
Kinners has joined #ocaml
stepcut has joined #ocaml
<stepcut> How do specify the regular expression for the character '[' appear at the beginning of the line in ocamllex ?
<whee> I don't know if you can specify the beginning of a line
<stepcut> hrm
<whee> you'd have to just use '[' and handle the rest in the parser
<stepcut> well, how do I specifiy the beginning of a line in the parser then :p
<whee> it's what comes after a newline :)
<stepcut> I have a line:
<stepcut> entry:
<stepcut> LSquare Other RSquare Newline lines {$2, $5}
<stepcut> hrm
<stepcut> I am having difficulty getting comments with square brackets in them to work :)
<whee> so your commenting system uses brackets as delimiters?
<stepcut> no, its for parsing smb.conf. [section] denotes a section, and # denotes a comment. But the parser does not handle '# [section]' properly. It should be just like any other commented out line, but the parser isn't treating it that way
<whee> how are you handling comments, in the lexer?
<stepcut> the lexer just marks '#' as the comment character, and the parser does the rest
<whee> that's probably the hard way to do it
<stepcut> oh?
<whee> normally what I do is something like 'rule lexer = parse '#' { ignore (lexeme lexbuf); comment lexbuf; lexer lexbuf } and comment = parse '\n' {ignore (lexeme lexbuf)} | _ { ignore (lexeme lexbuf); comment lexbuf }'
<whee> so when it hits a # it uses the comment lexer to eat everything until a newline, then it resumes parsing
<whee> or lexting, rather
<whee> lexing :(
<stepcut> yeah, but I need to hold on to the comments and rewrite them to another file...
<whee> you could treat the # as a unary operator
<stepcut> hrm
<whee> I guess that would end up in the parser then
<stepcut> I think I will have to work with the person that wrote this in the first place :)
<whee> if the parser builds an AST like it should then it'd be easy to deal with
<whee> I forget how to deal with operators like that in the parser, though :|
<whee> I guess %prec comes in there somewhere
<whee> if you can find a yacc example showing how '-' is implemented for negative numbers, I'm sure it'd be easy for you
<whee> since it's the same thing, except now it's '#' and it deals with everything up until a newline
<stepcut> hrm
<stepcut> | MINUS expr %prec UMINUS { - $2 }
<whee> well actually now I don't know if it's that easy :)
<stepcut> :p
<whee> oh$! I know what you can do
<whee> the same thing I was suggesting in the lexer, except actually do something with the characters being ignored
<whee> then just return a token representing the comment and what it contained
<mrvn_> When you recieve a #, eat up all up to the newline and then return with a recursive call to the tokeniser.
<stepcut> hrm
<mrvn_> Not sure how to do that in lex but I think thats automatic if you have no {}
<mrvn_> "{"[^}\n]*"}" /* eat up one-line comments */
<mrvn_>
<mrvn_> [ \t\n]+ /* eat up whitespace */
<whee> it should be simple, but I haven't used lex/yacc in a while so I have no idea :\
<mrvn_> from info flex
<whee> he also wants to store what the comment contained though mrvn
<mrvn_> you might want
<mrvn_> '#'.*'\n' or something
<whee> ocaml needs a nice parser combinator library
<mrvn_> whee: he does? waste of tokens.
<stepcut> waste of tokens!!
<whee> heh
<emu> hey, they cost a lot
<whee> it's only one added token
<whee> you just need to keep track of what you're going through in the lexer
<stepcut> oh?