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!)
netx has quit ["Leaving"]
_bt2 has left #ocaml []
crabstick has quit [Read error: 110 (Connection timed out)]
aij has quit ["brb"]
aij has joined #ocaml
bluestorm has quit ["Konversation terminated!"]
love-pingoo has quit [Read error: 110 (Connection timed out)]
piggybox has joined #ocaml
Cygaal has joined #ocaml
piggybox_ has quit [Client Quit]
m3ga has joined #ocaml
ita has joined #ocaml
<ita> hi there
<m3ga> hi!
cmeme has quit [Excess Flood]
cmeme has joined #ocaml
crabstick has joined #ocaml
jedai has quit [Read error: 110 (Connection timed out)]
Cygaal has quit [Read error: 104 (Connection reset by peer)]
Cygaal has joined #ocaml
Smerdyakov has quit ["Leaving"]
<ita> grr, i cannot find an example of writing a string into a file
Cygaal has quit [Remote closed the connection]
crabstick has quit [Read error: 110 (Connection timed out)]
<ita> okay, now i do have it
ita_ has joined #ocaml
ita has quit [Read error: 110 (Connection timed out)]
ita_ has quit ["later"]
kelaouchi has quit [Remote closed the connection]
buluca has quit [Read error: 113 (No route to host)]
bluestorm has joined #ocaml
netx has joined #ocaml
crabstick has joined #ocaml
crabstick_ has joined #ocaml
schme` has joined #ocaml
ktne has joined #ocaml
crabstick has quit [Read error: 110 (Connection timed out)]
<flux> that raise-mechanism does have the problem that intermediate cleanup functions will intervene..
schme has quit [Read error: 110 (Connection timed out)]
pango has quit [Remote closed the connection]
pango has joined #ocaml
G_ has joined #ocaml
G has quit [Read error: 110 (Connection timed out)]
Tetsuo has joined #ocaml
G_ is now known as G
ygrek has joined #ocaml
piggybox_ has joined #ocaml
piggybox has quit [Read error: 110 (Connection timed out)]
seafoodX has joined #ocaml
love-pingoo has joined #ocaml
m3ga has quit ["disappearing into the sunset"]
seafoodX has quit []
buluca has joined #ocaml
Cygal has joined #ocaml
Cygal is now known as Cygaal
jlouis_ has joined #ocaml
seafoodX has joined #ocaml
seafoodX has quit [Client Quit]
tty56 has joined #ocaml
jlouis has quit [Read error: 110 (Connection timed out)]
Liline has joined #ocaml
jedai has joined #ocaml
ygrek has quit [Remote closed the connection]
<bluestorm> hm
<bluestorm> i think there is a way to write some nativeint or int32 values using a special integer syntax (123L or something like that), but i can't find it in the manual
<bluestorm> hm
<ktne> hmm
<bluestorm> the lexer says 32l is int32, 32L is int64, 32n is nativeint
<bluestorm> 32n;;
<xavierbot> - : nativeint = 32n
<bluestorm> :}
<bluestorm> ktne: how is your parser going ? ^^
<ktne> L UL ul s
<ktne> us
<ktne> some of the ones in f#
<ktne> well the parser isn't doing well :)
<ktne> it seems that i hate to add a few extra things
<ktne> composition is not enough
<bluestorm> hm
<ktne> i guessi have to enclose all rules like this
<ktne> (seq (Literal "sdf")) :>
<bluestorm> "seq" ?
<ktne> sequential
<bluestorm> hum
<ktne> like rule:= a b c
<bluestorm> so is Literal "sdf" a sum type now ?
<ktne> vs (optional (Literal "sdf"))
<bluestorm> hm
<bluestorm> i'd have seen optional as a higher order construct, over seq and :>
<bluestorm> (hm or at :> level)
<ktne> if you have a | b | c
<ktne> then this translates into rule_a :> (optional rule_b) :> (optional rule_c)
<ktne> function optional param match_rule -> if param is None then return match_rule else return param
<ktne> basically (optional rule_b) checks whenever rule_a has been matched, if so it returns the result of the rule_a, otherwise it proceeds with matching rule_b
<ktne> (optional rule_c) does the same
<ktne> sequential rule -> if previous is matched then return (current rule is matched) else None
<ktne> the sequential is the opposite of optional
<ktne> optional is like OR, sequential is like AND
<ktne> "rule:= a b c" would be (AND a) :> (AND b) :> (AND c)
<bluestorm> hm
<ktne> "rule := a | b | c" would be (OR a) :> (OR b) :> (OR c)
<bluestorm> i see
<bluestorm> hm
<ktne> "rule := a {b|c}" would be (AND a) :> (MANY ((OR b) :> (OR c))
<bluestorm> i see another possibility
<ktne> {} means zero or more repetitions
<ktne> what possibility?
<bluestorm> you might have hm
<ktne> ah and also one last addition
<ktne> the function rules are eclosed in a NODE
<ktne> "rule:= a b c" would be NODE ((AND a) :> (AND b) :> (AND c))
<bluestorm> the rule type could be input -> output option
<ktne> so that the return is a tree of rules not a list of matched rules
<bluestorm> hm
<bluestorm> i'll try to write a little something
<ktne> or i could add the node inside AND and OR functions
<ktne> or maybe it's better to wrap the entire rule in a node
<ktne> this way i can solve node type identification too using a string
<ktne> for example
<ktne> "samplerule := a {b|c}" would be NODE "a sample rule" ((AND a) :> (MANY ((OR b) :> (OR c)))
<ktne> where NODE is string -> rule_result
<ktne> string -> (rule_result list)
<ktne> or string * (rule_result list) actually
<ktne> you see what i mean?
<ktne> so i would get a tree of nodes tagged with strings (the string is the function name that generated the rule)
<ktne> and each node spans from first byte of first rule in the node to last byte of last rule in the node
cratylus has joined #ocaml
<bluestorm> ktne: http://pastebin.be/4716
<bluestorm> it's the different view
<bluestorm> hm
<bluestorm> actually it's only a little monadic parser
<bluestorm> but i haven't done such things yet
<bluestorm> hm
<bluestorm> i could actually use && and || symbols
<ktne> hmm
<ktne> i see
<ktne> that's about what i wanted :)
<ktne> but it takes me more to code since i'm not familiar yet with the language :)
<ktne> one issue
<ktne> how do you deal with more complex rules?
<ktne> do you get just a list of Chars?
<ktne> that's exactly the input :)
<ktne> you need to get a tree
<bluestorm> hm
<ktne> replace "digit *> loop digit" with Node "digit" (digit *> loop digit)
<ktne> the list of chars should be a node in the tree and be tagged with string "digit"
<bluestorm> i could actually use a more clever "digit" rule
<bluestorm> hm
<bluestorm> i see
<ktne> well the rule seems ok
<ktne> it's just that it has to be tagged
<ktne> and stored in a tree
m3ga has joined #ocaml
buluca has quit [Read error: 113 (No route to host)]
snearch has joined #ocaml
m3ga has quit ["disappearing into the sunset"]
buluca has joined #ocaml
snearch has quit ["Nettalk6 - www.ntalk.de"]
<bluestorm> ktne: http://pastebin.be/4717
<ktne> right
<ktne> :)
<bluestorm> hm
<bluestorm> loop a is a+
mav has joined #ocaml
mav_ has joined #ocaml
<bluestorm> so bin should be node "num" (loop digit)
mav_ has quit [Read error: 104 (Connection reset by peer)]
<ktne> not unless you store a node for each loop
mav has quit [Client Quit]
<ktne> or maybe?
mav has joined #ocaml
<bluestorm> hm ?
<ktne> i don't think it should be (loop digit)
<bluestorm> actually
<ktne> because you can't recreate the input from(loop digit)
<bluestorm> ?
<ktne> you should be able to recreate the input from the output
<ktne> (loop digit) could be 0010 or 010101 or 01000 or 0
<bluestorm> but loop doesn't accept empty matches
<ktne> hmm
<ktne> ah
<ktne> i though you want to store "loop" digit into outpu
<ktne> output
<ktne> why input is input -> (input * token list) option and not input -> (input * token) option
<ktne> ?
<ktne> err, why rule is
<bluestorm> hm
<bluestorm> a rule can output more than one token
<ktne> hmm
<bluestorm> because if i had "token" instead of "token list", (&&) could not map to (@), wich i feel natural
<ktne> what @ does?
<bluestorm> i should have something like a "token accumulator" in the token type itself
<bluestorm> hm
<bluestorm> @ is list concatenation
<ktne> ah
<bluestorm> loop could not give [char ..; char ..; char ..]
<bluestorm> but something like
<bluestorm> (Seq (char ..) (Seq (char ..) (Seq (char ..) (char ..))))
<ktne> ah, i see
<bluestorm> however
slipstream has quit [Read error: 104 (Connection reset by peer)]
<bluestorm> you could say that the use of && is only justified if you know how to "unify" the two results, and thus use only a (input * token)
<bluestorm> (for example we could redefine bin by inlining loop and concatenating each digit into a string)
<ktne> ah
<ktne> i see
<bluestorm> that's a question of point of view
<ktne> i guess it's a guestion of how much you want to do in 1st phase vs 2nd phase
<ktne> hmm
<ktne> how can you differentiate between
<ktne> "00001"
<ktne> and "000101b"?
<bluestorm> hm
<bluestorm> the output is not the same
<bluestorm> (i don't understand your question)
<ktne> i guess a simple loop digit && char 'b' should work
slipstream has joined #ocaml
<bluestorm> *should* :P
<ktne> i was thinking for a moment that there might be some problems when two rules have a similar heading, but i guess i was wrong
<bluestorm> hm
<bluestorm> and there is something fun you can do with that monadic design
<bluestorm> if you transform "... option" into "... list"
<bluestorm> you've got a parser that can handle ambiguities
<ktne> hmm
<bluestorm> (by returning every different possibility)
<bluestorm> now, || use the first "good" output
<bluestorm> but he could return both, in a list
<ktne> but then what happens when you && two rules?
<ktne> you would have to make the dot product of the two lists?
<bluestorm> hum
<bluestorm> you would apply the second rule to every result of the first
<bluestorm> and flatten the list of list you've got
<ktne> cross product i meant
<ktne> i'm not sure what's the name in english :)
<ktne> here it's called carthesian product
<ktne> like SQL join
<bluestorm> the only "list product" i know is [a; b] [c; d] -> [(a, c); (a, d); (b, c); (b, d)]
<bluestorm> yes, this one
<bluestorm> but && is different
<bluestorm> it would be
<ktne> but what [a; b] && [c; d] would be?
<bluestorm> hm
<bluestorm> there is no [c; d]
<bluestorm> rule1 && rule2 is a rule
<ktne> but [c;d] is a list of ambigous solutions
<bluestorm> solutions of what ?
<bluestorm> [a;b] would be (rule1 input)
<ktne> ambigous matchings
<ktne> in that both c and d are proper outputs
<bluestorm> then you would do (rule2 a) @ (rule2 b)
<ktne> hmm
Cygaaal has joined #ocaml
<ktne> i'm not sure if replacing with a list would be suffient since the output of an ambigous rule would be a tree
<ktne> a tree of possible matchings
<bluestorm> modulo some factorizations, you could actually have the both codes looking like the same one
<ktne> would the last one return at least input length + 1 results?
<bluestorm> you can hide the option/list choice under a few primitives : "result found", "error", "sum of two result"...
<bluestorm> hm
<ktne> i guess the results should be filtered so that only if they consumed the whole input should be keps
<ktne> kept
<bluestorm> that's a possibilty
<ktne> i guess it could be done using an END symbol
<ktne> the main rule is && END
<ktne> so only the rules that reached END would be considered
<ktne> but that would complicate things i guess
Cygaal has quit [Read error: 110 (Connection timed out)]
<ktne> or maybe END is just defined to return something if the string position == input length
<ktne> that would be simple
<bluestorm> ktne: http://pastebin.be/4720
<ktne> hmm it works
<ktne> but i guess it would be better for performance to use an END symbol
<ktne> right :)
zap has joined #ocaml
<zap> Hello! Anybody knows where in Fedora is the ocamlfind or findlib utility? I have installed ocaml.rpm and it's not there...
<bluestorm> hum
<bluestorm> is there not a "findlib" package ?
<bluestorm> (it's a shame rwjones isn't there, he could answer you for sure)
hsuh has joined #ocaml
<zap> alas, no
<zap> there's ocaml-findlib.fc8.rpm
<zap> at least its mentioned somewhere in the net
<zap> but no findlib in f7
cratylus has left #ocaml []
hsuh has left #ocaml []
hsuh has joined #ocaml
cpst has quit [Read error: 110 (Connection timed out)]
hsuh has left #ocaml []
pango has quit [Remote closed the connection]
pango has joined #ocaml
moglum has joined #ocaml
moglum has quit [Remote closed the connection]
Smerdyakov has joined #ocaml
|Jedai| has joined #ocaml
jedai has quit [Nick collision from services.]
|Jedai| is now known as jedai
bpalmer has joined #ocaml
crabstick has joined #ocaml
ita has joined #ocaml
crabstick_ has quit [Read error: 110 (Connection timed out)]
<ktne> how can i get a pointer to a constructor?
<ktne> i have several constructors that take one parameter
<ktne> i would like to select the constructor based on a parameter
<love-pingoo> I'm afraid you can't do it like that
<ktne> hmm
<ktne> why not?
<ktne> isn'
<ktne> isn't a constructor a normal function?
<love-pingoo> you could have a function wrapping the constructor
<flux> hm, why not?
<love-pingoo> a constructor is not a function, indeed
<ktne> hmm
<love-pingoo> but for example (fun x -> Some x) is OK
<love-pingoo> I don't remember why constructors are not functions... efficiency ?
<ktne> type inference maybe?
<Smerdyakov> You can pattern match on constructor applications. You can't pattern match on function applications.
<flux> ktne, perhaps you mean something like ["magic", new a (* partial evaluation *); "DEFAULT", new b] and later (List.assoc constrs "magic") "parameter"
<ktne> i need to create an object based on a constructor
<love-pingoo> Smerdyakov: that's why functions are not constructors, but it doesn't really explain the other direction
<ktne> that is sent as parameter
<Smerdyakov> (This isn't to say that constructors can't be treated as functions like in SML.)
<Smerdyakov> But this makes it clear that ktne asked the wrong question, as he only wanted one use of constructors that can be modeled easily with functions.
<love-pingoo> ktne: the functional wrapper should fit your need, it's just not so concise
<ktne> hmm
<ktne> ok, i've used a function wrapper
<ktne> i would have preffered a better way
<Smerdyakov> ktne, try using SML. :-)
<ktne> i'm using F#
<Smerdyakov> Yeah, that's what you're using, and a better way is to use something else! :P
<ktne> :)
<bluestorm> hey Smerdyakov
<bluestorm> :]
<ktne> bluestorm i'm sending a constructor for a Digit type instead of node "num"
<bluestorm> (automagically declare a _Foo function for each Foo constructor in your types)
<ktne> bluestorm that's what i want to use it foo, but it seems i'm limted to sending (function x -> Digit x)
<Smerdyakov> Automatically defining identifiers starting with underscores that humans are supposed to use makes me queasy.
<bluestorm> hm
<bluestorm> hmm
<bluestorm> it *might* be actually possible to fool camlp4 into thinking Foo is a lowercase identifier :-'
<ktne> bluestorm Some (("00001", 5), [Digit [Char '1'; Char '0'; Char '0'; Char '0'; Char '0']])
<bluestorm> hm, and you're using something like node (fun x -> Digit x) bin ?
<ktne> yes
<bluestorm> ok
<bluestorm> hm
<bluestorm> if you were using ocaml, you could use camlp4 for syntaxic support
<bluestorm> :}
<ktne> :)
<ita> or ocaml+twt
<mbishop> watch your mouth!
<mbishop> ...oh you said "twt"...never mind! :P
<bluestorm> hm
<bluestorm> btw, do you know if the twt author is somewhere around ?
<bluestorm> (he *might* be interested in my camlp4-twt summer attempt)
G has quit [Connection timed out]
<ita> bluestorm: the camlp4 can be chained with twt already
<bluestorm> hm
<bluestorm> i guess, as it's just a text-to-text preprocessor
<ita> bluestorm: you have not tried ? :-) i think the command-line is something like -pp "camlp4 ocaml+twt"
<bluestorm> hmm
Cygaaal has quit [Read error: 104 (Connection reset by peer)]
<bluestorm> ita: is this done by writing twt as an campl4 extension ?
<ita> bluestorm: no, this is done by chaining the preprocessors
<bluestorm> ok
<ita> bluestorm: look in the twt docs ..
<ita> the author uses it already
<ita> i have asked him if the # at the beginning of lines could be used for commenting as in python, but he did not like the idea :-/
Cygaaal has joined #ocaml
<bluestorm> hm
<bluestorm> you mean, instead of (* *) ?
hsuh has joined #ocaml
<bluestorm> you could do a camlp4 extension for that
<ita> in practice it is # xxxx \n
<ulfdoz> What's the problem with (* *)?
<ktne> cya tommorow everyone
ktne has quit []
<ita> ulfdoz: it is just faster to comment lines by a # at the beginning
hsuh has quit ["am gonna make sum kaffee"]
<bluestorm> hm
<bluestorm> M-;
<ita> bluestorm: ?
<bluestorm> a live demo of the emacs "comment region" command
<bluestorm> (i think every editor has some command like that now, Kate does have one at least)
<ulfdoz> There 's really someone, knowing kate? ;)
<bluestorm> hm
<ita> ulfdoz: i do
<ita> but i prefer vi
<bluestorm> i'm always suprised to see that lots of programmers actually use kate to code
<ita> guess what ? even more programmers are using eclipse
<ita> i hardly know a worse text editor
snearch has joined #ocaml
<ulfdoz> In ircnet "they" all use vim. At least, they do admit, that something else could do some job.
* Smerdyakov finds an interesting ad on LinkedIn: http://www.rentrak.com/
<Smerdyakov> Anyone heard of them?
<ita> i have seen something like this nearby
<ita> it's called rentrakar
<Smerdyakov> They're advertising for functional programmers, but I've not yet seen information on how they use FP in their work.
hsuh has joined #ocaml
<Smerdyakov> I've been there, and there's no mention of _using_ FP there.
<ita> just on languages
<bluestorm> « You're probably used to being the smartest developer on your team (but are too humble to admit it) »
<bluestorm> yay
<bluestorm> a Smerdyakovesque software company :-}
<Smerdyakov> bluestorm, you're so European, pretending everyone is equal!
<bluestorm> hm
<ita> ?
<bluestorm> i'm not really serious about that
<Smerdyakov> Besides, it can't be a Smerdyakovesque company with that quote, because I'm _not_ too humble to admit it! :D
<bluestorm> and they may well be right anyway
<bluestorm> Smerdyakov: do you have a company ?
<bluestorm> aah btw
<bluestorm> i read your name this summer
<Smerdyakov> I don't have a company. I have a name, though.
<bluestorm> (it's maybe common for you that people read your name in some academic setting, but i'm not used to reading papers from still alive peoples yet)
<bluestorm> hm
<bluestorm> i think it was in the Singularity paper
<Smerdyakov> Could be. I might be acknowledged.
<Smerdyakov> You only read papers by dead people? You've missed a lot of cool stuff. :D
<bluestorm> hm
<ita> haha
<bluestorm> i do not read papers very often
<bluestorm> hm
<bluestorm> actually i wanted to say something like "written by someone i kind of know" but there are some difficulties in that way
<bluestorm> you could understand "it's the first time i can bother someone on IRC after seeing his name on a paper"
<Smerdyakov> You write "hm" too much!
<ita> hm ?
<bluestorm> People might believe i'm thinking
<bluestorm> (at least i do, when writing "hm")
<Smerdyakov> I think such utterances are spam-like on IRC.
<mbishop> I have a tendency to say "heh" quite a bit
<ita> Smerdyakov: and the size does matter
crabstick_ has joined #ocaml
ygrek has joined #ocaml
crabstick has quit [Read error: 110 (Connection timed out)]
crabstick has joined #ocaml
crabstick_ has quit [Read error: 110 (Connection timed out)]
snearch has left #ocaml []
Demitar has quit [Read error: 113 (No route to host)]
zap has left #ocaml []
Cygaal has joined #ocaml
hsuh has left #ocaml []
piggybox_ is now known as piggybox
Cygaaal has quit [Connection timed out]
ygrek has quit [Remote closed the connection]
hsuh has joined #ocaml
hsuh has quit [Remote closed the connection]
G has joined #ocaml
mbishop has quit [Remote closed the connection]
slipstream-- has joined #ocaml
martin_ has joined #ocaml
martin_ is now known as mbishop
Demitar has joined #ocaml
slipstream has quit [Read error: 110 (Connection timed out)]
jedai has quit [Read error: 113 (No route to host)]
Liline has quit [Remote closed the connection]
pattern has quit [Read error: 104 (Connection reset by peer)]
pattern has joined #ocaml
jedai has joined #ocaml
cpst has joined #ocaml
jedai has quit [No route to host]
ita has quit [Remote closed the connection]
cpst_ has joined #ocaml
cpst has quit [Read error: 104 (Connection reset by peer)]
cpst_ is now known as cpst
EliasAmaral has joined #ocaml