mbishop changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | Grab Ocaml 3.10.0 from http://caml.inria.fr/ocaml/release.html (featuring new camlp4 and more!)
pants1 has joined #ocaml
tty56 has quit [Read error: 60 (Operation timed out)]
smimou has quit ["bli"]
descender has quit [Read error: 113 (No route to host)]
benny has joined #ocaml
sgillespie has joined #ocaml
<sgillespie> hello
<sgillespie> I'm trying to understand an error here...Its probably pretty simple
<eu-prleu-peupeu> hi sgillespie
benny_ has quit [Read error: 110 (Connection timed out)]
<sgillespie> i understand the bad style of -- with Not_found -> raise Not_found...that was just a placeholder
<sgillespie> can anyone help me figure out how to get this to compile and run?
<sgillespie> if i take out the last line (| [] -> 0;;) it compiles
eu-prleu-peupeu has quit [Remote closed the connection]
<bluestorm> sgillespie:
<bluestorm> | [] -> ... get handled by the "with" matching
<bluestorm> it's a syntaxic problem
<bluestorm> use
<bluestorm> in begin try ... with .... -> ... end
<sgillespie> ahhh...thats what i figured
<bluestorm> (i think that error is named "dangling match" or something like that)
<sgillespie> i keep forgetting about begin..end
<sgillespie> I appreciate the help
<bluestorm> you're welcome ^^
seafoodX has quit []
seafoodX has joined #ocaml
leo037 has quit ["urpmi sommeil"]
jatqceer has joined #ocaml
<Mr_Awesome> anyone here familiar with ocamllex?
<zmdkrbou> yup
<Mr_Awesome> ok, im trying to create a separate starting symbol for parsing strings. however, i cant figure out how to return the collect STRING token as well as switching back to the original start symbol
<Mr_Awesome> *collected
<Mr_Awesome> i have | '"' { string "" lexbuf }
<Mr_Awesome> then in the string start symbol i have | '"' { (* need to return the collected string and go back to the original start symbol *) }
<Mr_Awesome> so, anyone know how to accomplish that?
<zmdkrbou> you juste insert (STRING s) here, where s is your collected string
<Mr_Awesome> right, but if i just have { STRING(s) } it will recurse to the string start symbol, when i need to go to the other start symbol
<zmdkrbou> why would it recurse to the string start symbol ?
<Mr_Awesome> doesnt it by default recurse to the start symbol in which the action occurs?
<zmdkrbou> when you finally return a value, you're done with calling the lexing rules recursively
<zmdkrbou> your rules are just recursive functions
<Mr_Awesome> oh, so all i need is { STRING s } and it will automatically return to the original start symbol?
omnipath has joined #ocaml
<zmdkrbou> it doesn't need to return to any start symbol
<zmdkrbou> this part of the lexing is over, the lexer sends (STRING s) as a token to the parser
<zmdkrbou> and when the parser calls the lexer again, the lexer starts with the normal symbol
<Mr_Awesome> oh ok. i didnt realize thats how it worked
<Mr_Awesome> thanks :)
<zmdkrbou> np
<Mr_Awesome> what would be a good route to take if the parsing for numeric literals was very complex and i needed a separate lexer and parser for them? would it be a good idea to just grab anything that could be a numeric literal with the regular lexer and then after i have the AST go back and parse the numeric literals with the specialized lexer/parser?
<Mr_Awesome> and my other question is, how can i make sure in the lexer that a lexeme is followed by a certain character? right now im just matching the following character and then backing up lexbuf.lex_curr_pos, which seems to work. but is there a better way?
<Smerdyakov> You want to check for future characters but not consume them? That's against the lex spirit.
<zmdkrbou> looking forward to check that something precise will follow a given character or token is somehow parsing work
<zmdkrbou> (and how can you have numeric literals that require so much effort ??)
<Mr_Awesome> its r5rs scheme numeric literals
<Mr_Awesome> they need to be parsed separately so i dont have to worry about a + or / token in a numeric literal getting confused with a + or / identifier
<zmdkrbou> berk
<Mr_Awesome> well i need to make sure there is some type of delimiter between, for example, numeric literals and identifiers. for example, i dont want 35foo getting parsed as a numeric token and an identifier, i want that to be an error
<Smerdyakov> You don't _need_ to do this.
<Mr_Awesome> i do to be compliant with the standard
<Smerdyakov> You can use yacc to do some of what you're thinking of as lexing.
<Mr_Awesome> how?
<Mr_Awesome> iirc flex allows you to explicitly specify following characters that wont be consumed
<Smerdyakov> A non-terminal for numeric literals, for instance.
<Mr_Awesome> its not parsing thats the problem
<Mr_Awesome> once i get the proper tokens, parsing is rather simple
<Mr_Awesome> the hard part is determining which token to output
<Smerdyakov> I'm saying that you should rethink what's tokenizing and what's parsing.
zarvok has quit ["BitchX-1.1-final -- just do it."]
<Smerdyakov> Or, honestly, I couldn't care less about Scheme, with its bullshit syntax. :P
<Mr_Awesome> ie, if i see a '+', how would i know if its an identifier or part of a numeric literal?
<zmdkrbou> Mr_Awesome: the syntax for scheme numeric literals is probably not a regular language
<zmdkrbou> => you should use a parser for that
<Mr_Awesome> well, you need tokens before you can parse, right?
<zmdkrbou> yes, but you need to have more elementary tokens
<zmdkrbou> everything you can do in a lexer, you can do in a parser
<Mr_Awesome> what do you mean? how can i get more elementary than PLUS, MINUS, I, INTEGER, EXP_MARKER, etc?
<zmdkrbou> than INTEGER for example, yes
<zmdkrbou> it would be stupid, but yes
<zmdkrbou> in your case, ie for WHATEVER_HORRIBLE_SCHEME_LITERAL, it's not stupid, it's needed
<Mr_Awesome> how would i make INTEGER more elementary?
<zmdkrbou> you make a DIGIT token
<zmdkrbou> and your parser takes a list of digits, and makes an integer of it
<Mr_Awesome> well, hypothetically, if i had (infix 3 + i), i being a variable defined to 5, the parser would then see <identifer> <digit> <plus> <i> and reduce it to <identifier> <complex> when it should be <identifer> <integer> <identifier> <identifer>
<Smerdyakov> "You need tokens before you can parse." No.
<Mr_Awesome> oh?
<zmdkrbou> the idea that "+" can be the usual addition operator *and* an identifier makes me sick ...
<Mr_Awesome> no its not an addition operator
<Mr_Awesome> its an identifier, just like "add" or "foo"
<Mr_Awesome> its just by default assigned the value of the primitive addition function
<Mr_Awesome> however, it can appear in numeric literals like "+52" "7e+2" "8+3i" "+i" etc
<zmdkrbou> is "8 + 3i" a numeric literal ?
<Mr_Awesome> in scheme, there is no such thing as an "operator" so to speak. everything is an identifier or a literal, things like +, =, =>, <, /, *, etc are all just identifiers
<Mr_Awesome> no, 8 + 3i is a numeric literal (8), an identifier (+), and an invalid token (3i), or, for some implementations, a valid token (3i)
<zmdkrbou> ok, so spaces matter
<Mr_Awesome> indeed
<zmdkrbou> then what's your problem ?
<zmdkrbou> you can write a regexp for your literals
<Mr_Awesome> i can write a regexp that will match any literal, yes. but the lexer alone isnt powerful enough to discern the meaning of the numeric literal
<zmdkrbou> the meaning ?
<Mr_Awesome> which is why i need to use more elementary tokens for the parser to do that job
<Mr_Awesome> yes, as in, 3+i is the complex number 3+i
<Mr_Awesome> and 2e2 is the number 200
<zmdkrbou> you can write a lexer which will recognize (infix 3 + i) as you want
<zmdkrbou> a simple one
<zmdkrbou> you just have to write a regexp for numeric literals, where there's no space
<zmdkrbou> so that (infix 3 + i) will be <id> <num> <id> <num>
<zmdkrbou> (or <id> for the last one, depends if you want "i" to be a numeric literal)
<Mr_Awesome> i dont quite understand what you mean by "a regexp for numeric literals"
<Mr_Awesome> right, i would actually be an <id>
<zmdkrbou> something like : integer ('+' integer 'i')?
<Mr_Awesome> right, i tried that, but its not that simple
<zmdkrbou> where integer is '+'? digit+ ('e' '+'? digit+)?
<Mr_Awesome> for complex numbers, its "real? sign ureal? 'i'"
<Mr_Awesome> where real can either be an integer, a decimal number (ie 5.05), or a ratio (ie 3/5)
<zmdkrbou> and so ?
<zmdkrbou> as long as you don't allow spaces inside your numeric literals, you have no problem
<zmdkrbou> or do you have a counter-example ?
<Mr_Awesome> so how would i get the values out of these?
<zmdkrbou> ah, i get what you're saying know
<zmdkrbou> -k
<Mr_Awesome> the only solution ive come up with is to write a regexp that matches any numeric literal, then pass that numeric literal as a string to a separate lexer
<zmdkrbou> that's a solution
<zmdkrbou> the other one is to move the numeric literals recognition out of the lexer, into the parser
<zmdkrbou> but then you have to have a space-aware parser
<zmdkrbou> which is plain shit
<Mr_Awesome> finally, someone sees my predicament :)
<Smerdyakov> I don't get it. Scheme is such a trivial language to parse; why don't you just write a manual parser?
<Mr_Awesome> i figured it would be easier this way
<Mr_Awesome> i dont see how parsing manually would make it easier
<Mr_Awesome> Smerdyakov: you said looking at characters without consuming them is against lex spirit. but how else would you resolve the delimiting problem i have? (aside from writing it manually)
<Smerdyakov> You wouldn't use a lexer, that's how.
<Smerdyakov> Or, hey, let's see if I understand this.
<Smerdyakov> Why don't you define a regexp for identifiers that includes numeric constants?
<Smerdyakov> In your parser action for that token, look at the identifier and give it special treatment if it is a numeric constant.
<Mr_Awesome> ok, but if the regexp just grabbed the whole numeric literal, when would i actually determine the value of the constant?
<Mr_Awesome> in a separate function?
<Smerdyakov> In the parser action.
<Mr_Awesome> right, which would require a function to parse the value out of the constant manually
<Smerdyakov> No, this has no fundamental connection to functions.
<Smerdyakov> You can write code inline.
<Mr_Awesome> well, yes i realize that
<Mr_Awesome> bottom line, id have to parse the value manually
Mr_Awesome has quit ["time to impregnate a moth"]
jatqceer has left #ocaml []
Mr_Awesome has joined #ocaml
G_ has joined #ocaml
G__ has joined #ocaml
G has quit [Read error: 110 (Connection timed out)]
G__ is now known as G
G_ has quit [Read error: 110 (Connection timed out)]
ygrek has joined #ocaml
seafoodX has quit []
descender has joined #ocaml
gene9 has joined #ocaml
G has quit ["FATAL: Module brain not found."]
gene9 has quit ["Client Exiting"]
G has joined #ocaml
xavierbot has joined #ocaml
<tsuyoshi> we need a win32 ocaml cross compiler in debian
dadfa has joined #ocaml
dadfa has left #ocaml []
<flux> that could be nice.
<flux> I would also like to see a "win32 ocaml distribution" with most of the nice libraries (gtk, sdl, libnet,..) and a mechanism for installing the rest.
<flux> I personally do extremely little stuff with windows so it could be an easy way to write software for a larger user base..
<tsuyoshi> yeah
<flux> could be useful at work too; getting those in-house tools to sales people running windows..
<tsuyoshi> are cmxa files even different between linux and windows?
<flux> things like path separator have the potential of being inlined.. but I don't know, really
<tsuyoshi> I wonder if you could just use the debian i386 packages for the libraries
<tsuyoshi> hmm
<flux> they might come with .so-files, though
<flux> and that's not very windowsy
<tsuyoshi> using / for path separator works in windows iirc, but there's probably other differences I can't think of atm
<tsuyoshi> so you probably need to recompile the libraries for windows..
<tsuyoshi> but once you have the cross compiler that shouldn't be difficult
noteventime has joined #ocaml
<tsuyoshi> an arm cross compiler would be cool too
<tsuyoshi> I want to write rockbox plugins in ocaml
<flux> hmh, perhaps that would be cool, but I would keep to C in that case :)
<flux> (rockbox rocks, btw)
<flux> unfortunately the standard ocaml distributions doesn't quite lend itself to cross compiling..
<tsuyoshi> why not?
<tsuyoshi> hm.. I need to do laundry soon so it has time to dry before tomorrow morning
<tsuyoshi> actually.. I need to buy some laundry detergent
<flux> you need to patch the build system to make it work
<flux> (makefiles atleast, perhaps even the source..)
<flux> some attempts are documented somewhere on the web/mailing lists
love-pingoo has joined #ocaml
smimou has joined #ocaml
<love-pingoo> anybody familiar with the Weak module ?
<love-pingoo> "Each value may magi‐
<love-pingoo> cally disappear from the set when it is not used by the rest of the
<love-pingoo> program any more."
<love-pingoo> I'm storing in a weak hashtable a value of type (t*string) where the string is never used anywhere else in the program.
<love-pingoo> I hope I guess right saying that the entry may magically disappear only if the value of type t is no more used outside the table ?
Mr_Awesome has quit ["time to impregnate a moth"]
<pango> I'd say no... Here the value is the thing of type t * string... references to its components are not enough to keep it "alive"
<love-pingoo> Seeing some behaviours of the program, I started to suspect that....
<love-pingoo> :((
<love-pingoo> I have some representation of lambda-terms with un-named free variables.
<love-pingoo> and sometimes I want to attach a naming hint to some variable
<love-pingoo> if I use a normal hash table, adding the hint will make the variable never gc-ed
<love-pingoo> so I thought of Weak
<pango> values must have a non-weak reference from somewhere, otherwise they'll be collected; Weak hash tables can be useful to find existing values without preventing them from being collected, but they cannot be the only reference to those values
<pango> you should store direct reference to the hints instead of weak hash table keys (if you need a weak hash table at all)
<flux> I do wonder if someone has made efficient use of the Weak-module.. the weak map somewhere in the net seems much more useful.
<flux> but perhaps there's an usecase I haven't thought of
<pango> flux: they're useful for value consing, for example
<love-pingoo> pango: if I don't use weak, then the reference to the hint will never get lost... otherwise, I could store a (t Weak.t * string) and I could manually remove it when the weak pointer gets empty
<pango> (hash consing ?)
<pango> love-pingoo: I don't know... what is their liveliness tied to?
G_ has joined #ocaml
<love-pingoo> that's really complex
<love-pingoo> plus, the lib has two applications, one of which lets the user control more things, which affects the liveness too
<love-pingoo> I could afford a manual cleanup from time to time, but I wish I had a simpler solution
<love-pingoo> I could set a finalizer to remove the entry (and use a weak ptr in order not to prevent the variable to be freed)
<love-pingoo> gotta go
G has quit [Read error: 110 (Connection timed out)]
oxylin has joined #ocaml
seafoodX has joined #ocaml
oxylin has quit ["Ex-Chat"]
seafoodX has quit [Read error: 110 (Connection timed out)]
noteventime has quit [Remote closed the connection]
noteventime has joined #ocaml
leo037 has joined #ocaml
slipstream-- has joined #ocaml
slipstream has quit [Connection timed out]
leo037 has quit [Remote closed the connection]
leo037 has joined #ocaml
screwt8 has quit [Read error: 104 (Connection reset by peer)]
screwt8 has joined #ocaml
screwt8 has quit [Remote closed the connection]
pango has quit [Remote closed the connection]
pango has joined #ocaml
tomppa has joined #ocaml
screwt8 has joined #ocaml
hsfb has joined #ocaml
<hsfb> hello folks.. i'm sry to ask this if it sounds really basic...
<hsfb> i'd like to know if there is a way to get stdout from a Sys.command
noteventime has quit [Remote closed the connection]
noteventime has joined #ocaml
<Smerdyakov> This isn't Perl. The types of library functions tell you exactly how you can use them.
fluctus has joined #ocaml
<tomppa> Does anyone know if the current ocamlbuild works on Windows?
<pango> hsfb: check Unix.open_process_in instead
tomppa has quit ["Ex-Chat"]
qwwqe has joined #ocaml
tomppa has joined #ocaml
<hsfb> pango: exactly what i was thinking. thank you
<pango> np
tomppa has quit ["Ex-Chat"]
edwardk has joined #ocaml
buluca has joined #ocaml
eu-prleu-peupeu has joined #ocaml
edwardk has quit ["Leaving."]
pants1 has quit [Read error: 110 (Connection timed out)]
pants1 has joined #ocaml
eu-prleu-peupeu has left #ocaml []
G has joined #ocaml
G_ has quit [Connection timed out]
malc_ has joined #ocaml
G_ has joined #ocaml
Mr_Awesome has joined #ocaml
buluca has quit [Remote closed the connection]
benny has quit [Read error: 110 (Connection timed out)]
buluca has joined #ocaml
G has quit [Connection timed out]
G has joined #ocaml
ygrek has quit []
pants1 has quit [Read error: 113 (No route to host)]
pants1 has joined #ocaml
G_ has quit [Connection timed out]
gene9 has joined #ocaml
hsfb has left #ocaml []
slipstream has joined #ocaml
twobitsprite has joined #ocaml
<twobitsprite> in ocamllex, each rule creates a function exported by the resulting module, right?
<twobitsprite> and this function produces a stream, no?
<twobitsprite> (I've messed with ocamllex/ocamlyacc a while ago, but can't remember exactly how it worked)
slipstream-- has quit [Read error: 110 (Connection timed out)]
gene9 has quit ["Leaving"]
love-pingoo has quit ["Connection reset by pear"]
bluestorm has quit ["Konversation terminated!"]
<twobitsprite> ow do you turn file-descriptors returned from the Unix.openfile into channels as used by, i.e., the Stream.of_channel function?
<twobitsprite> s/ow/how
<twobitsprite> I've searched the docs for the past half hour and come up with nothing
<pango> Unix.{in,out}_channel_of_descr ?
<twobitsprite> duh :P
<twobitsprite> I must be going blind
descender has quit [Remote closed the connection]
leo037 has quit ["urpme fatigue (toi aussi misc)"]
Smerdyakov has quit ["Leaving"]
edwardk has joined #ocaml
<malc_> edwardk: wtf?
<edwardk> ?
<edwardk> heh
<edwardk> heya =)
Smerdyakov has joined #ocaml
<malc_> hey hey.. the question still stands though :)
<edwardk> heh, what? I like Haskell, does that mean I can't occasionally find a use for ocaml? =)
<edwardk> integrating the olabl stuff actually made me like ocaml a bit =)
<malc_> It means precisely that actually. Those two are mutually incompatible.
<edwardk> ah
* edwardk disappears in a puff of logic.
<malc_> Integrating olabl where?
<edwardk> forever ago for named arguments, etc. the stuff that ocaml does that haskell doesn't do.
<edwardk> polymorphic variants etc. the stuff that has been making my toy compiler so hard to write
<malc_> Ah.. it was indeed a while ago ... 2.99.. hence my confusion
<edwardk> yeah
noteventime has quit ["Leaving"]
hsfb has joined #ocaml
malc_ has quit ["leaving"]
seafoodX has joined #ocaml
G_ has joined #ocaml
seafoodX has quit []
seafoodX has joined #ocaml
seafoodX has quit [Client Quit]
G has quit [Read error: 110 (Connection timed out)]
mnemonic_ has joined #ocaml