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> http://ocaml.pastebin.com/m374c263d <--could someone explain me my type error?
Optikal_1 has joined #ocaml
* palomer needs someone with serious type skills
pango has quit [Remote closed the connection]
<palomer> http://ocaml.pastebin.com/m5901d5ff <--could someone explain me why I'm getting this error
yminsky has joined #ocaml
<palomer> ahh, got it, nevermind
<mbishop> why do you call get_right_sibling when you have get_right_sibling_specific?
<palomer> that was the mistake
<palomer> but wait, there's more!
<palomer> http://ocaml.p.tyk.nu/108 <---this is what bothers me
<palomer> indeed, this error is what's stopping me from writing a generic traversal function
<palomer> for some reason, ocamlc -i gives the type
<palomer> val traverse :
<palomer> ((< get_child : 'a option; get_parent : ('a, 'b) either option;
<palomer> get_right_sibling_specific : 'a option; .. >
<palomer> as 'a) ->
<palomer> 'c) ->
<palomer> 'a -> unit
<orbitz> is that the wrong type?
<palomer> to me it is
<orbitz> that's the problem with type inference
<orbitz> specifcy the correct type and somewhere and that will probably flesh out the mistake
<palomer> well, to me it should have type
<palomer> val traverse :
<palomer> ((< get_child : (< get_child : 'b option;
<palomer> get_right_sibling_specific : 'b option; .. >
<palomer> as 'b)
<palomer> option;
<palomer> get_parent : ('a, 'c) either option; .. >
<palomer> as 'a) ->
<palomer> 'd) ->
<palomer> 'a -> unit
<orbitz> specify it then:)
<palomer> it's not as easy as that
* palomer wishes it was
<orbitz> sure it is!
<palomer> still get the same error
<palomer> type annotations are suggestions in ocaml
<palomer> ocaml can say "I'm going to give it a more specific type"
<palomer> and there's nothing I can say!
<palomer> does ocaml have rank 2 types?
<palomer> notice that my program works if you remove the f a; call in traverse_down
pango has joined #ocaml
<palomer> ugh, finally found the solution
<palomer> gawd damn it's ugly though
<jdrake> Greetings! I have problems with an attempt to make an if statement. http://paste.lisp.org/display/60660
<jdrake> Line 23, where it says 'else'
<jdrake> It says 'syntax error', and it would be lovely to get much more detail on this.
<palomer> what's on line 23?
<jdrake> else
<jdrake> Its on the paste link on my first line there
<palomer> what's C code doing in there?
<palomer> if you use http://ocaml.p.tyk.nu/ we can see the line numbers
<palomer> please paste the code and the error message
<palomer> while you're doing this, I'll go take a walk
<palomer> brb
<pango> jdrake: the 'if' ends with line 21
<pango> jdrake: you lack begin .. end pair (or parens)
<pango> then you can remove the useless else () ...
<jdrake> pango: hmm
<jdrake> How would it end with line 21, when I use a ';'?
<pango> it ends there, yes
<jdrake> IS there a way I can use pattern matching to make this expressed simpler? (using the pattern matching found possible in normal 'let' that I have seen at outer level)
Amorphous has quit [Read error: 110 (Connection timed out)]
Amorphous has joined #ocaml
yminsky_ has joined #ocaml
<pango> you could write a high order function to implement loops over a float range... float_loop beginning end step f...
<pango> I don't see what you want to use pattern matching for in this context
<jdrake> I will look at it later, I just better get something working first
<pango> btw as written I think 2.0 *. (acos (-1.0)) will be evaluated at each iteration, unless the compiler is smart enough to evaluate it at compile time
<pango> (only looking at generated code will tell, I'm not sure)
<jdrake> I have a few ideas to make it work better
<pango> you'll have to use +. -. *. etc. to handle floats
<pango> + - * are int operations only
coucou747 has quit ["bye ca veut dire tchao en anglais"]
<jdrake> I am aware
<jdrake> I missed one :-)
<pango> and least five others in the code you pasted
<jdrake> hmm
<jdrake> I will look closely
<jdrake> Is there a syntax for something like let ... = x where x = ....?
<jdrake> There was a language I saw that in one
<jdrake> once.
<pango> someone wrote some preprocessing to do that
<mbishop> Haskell has where
<jdrake> That must have been it
<jdrake> Haskell is a very nice language for many things, I found.
<pango> it's not in standard syntax because it makes it harder to follow evaluation order
<jdrake> Fair enough
<pango> it's not a problem in Haskell since it's lazy
* palomer never understood what's the point of where clauses
<pango> (and pure)
<jdrake> There was a feature in perl that I found rather nice at times, it is a statement followed by an if clause to determine if it would even do the original statemnet.
<palomer> ruby has it
<palomer> haskell has something similiar
<palomer> similar
<palomer> (called when)
<jdrake> I try to forget that I ever saw ruby :p
<palomer> wait, ocaml has it
<palomer> if foo then bar
<palomer> oh, you want your foo after the bar?
<jdrake> In that syntax, yes.
yangsx has quit [Excess Flood]
<jdrake> I notice that some examples (in ocaml) have a series of let in let in let in ... ; is there a way of doing multiple let assignments without the 'in' being in every one until the end?
yangsx has joined #ocaml
<palomer> jdrake, nope
<palomer> notice that you can also do let .. and .. and ..
<jdrake> I find the 'in' repetition to be ugly
<jdrake> I like the idea of repeating 'and'
<pango> let a, b = 2, "hello" in ...
<pango> beware that using and can lead to some unexpected monomorphisation
<jdrake> hmm?
<pango> because types are evaluated all at once instead of separately
<palomer> err?
<pango> I remember helping someone that used 'and' extensively and had strange typing problems... converting everything to 'let in' just corrected the problem
yminsky has quit []
<palomer> funky
yminsky has joined #ocaml
<jdrake> This is an example of what I would like to do: http://ocaml.p.tyk.nu/111
<jdrake> I think it believes I am redefining it; because, it says unused variable loop
<jdrake> (second line)
<pango> you don't define functions in parts in OCaml
<jdrake> I have seen pattern matching in a similar way, but not inside a function
<pango> you could write it as http://ocaml.p.tyk.nu/112, but rounding problem will probably bite you
<jdrake> hmm, now I need to convert float to integer
<pango> int_of_float, or truncate
<jdrake> It does appear to have bitten me in some way, I believe I have an infinite loop on em
<pango> actually that was bound to happen, given that 2.0 *. (acos (-1)) is not even remotely a multiple of 0.01
<jdrake> I will have to write a proper circle draw function; rather than a quick and dirty one
<pango> fast circle drawing functions don't look like that at all
<jdrake> I know :-)
<jdrake> I just wanted something quick
<jdrake> (to write)
<jdrake> I have seen one based on symmetry of 8 points. I shall implement one of those; but I need to analyse it more in detail, so I understand it before I use it.
<palomer> fast circle drawing is fun!
<pango> 4am here... nite all
<palomer> pango, night
<jdrake> Good night, render text well!
<jdrake> 13 days uptime on my desktop, not bad for a laptop
<jdrake> Night all, merci pour l'aide!
jdrake has quit ["Ex-Chat"]
<pango> palomer: last one for the road: http://ocaml.p.tyk.nu/113 ... and now I'm really gone!
yminsky has quit []
yminsky has joined #ocaml
<palomer> ah yes
<palomer> classic
yminsky has quit []
yminsky has joined #ocaml
yminsky has quit []
Loki_ has quit [Read error: 113 (No route to host)]
Kopophex has quit [Read error: 110 (Connection timed out)]
netx has quit [Read error: 104 (Connection reset by peer)]
Kopophex has joined #ocaml
Loki_ has joined #ocaml
Kopophex has quit [Connection timed out]
Kopophex has joined #ocaml
blackthorne_ has joined #ocaml
<blackthorne_> hi
<orbitz> hi
<orbitz> i'm trying to implemetn a simple CFG parser evaluating inside Ocaml, for teh CFG defition i'm thinking a list of (nonterminal, ([pattern], funcion)) how i want to go about this, but i think this design kind of sucks, especially the 'fun' part
<palomer> I just wrote a fun CFG parser
<palomer> type production_names = [`prod_name1|`prod_name2|..]
<palomer> type pattern = (string option list)
<palomer> actually
<palomer> (string,nonterminal) either list
<orbitz> i'll show you mine with i'm done os you can show me wha ti did wrong
<orbitz> is thre an identity function?
nuncanada has quit [Connection timed out]
netx has joined #ocaml
ygrek has joined #ocaml
nuncanada has joined #ocaml
jonafan_ has joined #ocaml
<palomer> THIS IS RIDICULOUS!
<palomer> I just spent one hour hunting down a type error
<palomer> orbitz, you'll have to define it
<palomer> let id x = x
<palomer> I have a file Utilities.ml where I put all my tidbits
Linktim has joined #ocaml
<palomer> is it possible to get the latest ocaml cvs from godi?
jonafan has quit [Read error: 110 (Connection timed out)]
ygrek has quit [Remote closed the connection]
<flux> yes
ygrek has joined #ocaml
<flux> IIRC you can configure it to take HEAD (or any other branch) with godi_console
<flux> in any case, the ocamlnat web page has instructions
netx has quit [Read error: 110 (Connection timed out)]
<palomer> ocamlnat?
<palomer> google doesn't know very much about it
Kopophex has quit [Read error: 110 (Connection timed out)]
<flux> natdynlink was a better keyword: http://alain.frisch.fr/natdynlink.html
<palomer> cool
<palomer> what's the easiest to write a string to a file and then read it back?
sirius6b has joined #ocaml
al-maisan has joined #ocaml
<flux> let write_string fname str = let f = open_out fname in try output_string f fname with exn -> close_out
<flux> etc
<flux> I actually pressed enter prematurely, so you need to fix what's missing :)
Tetsuo has joined #ocaml
<sirius6b> Did anybody build glcaml apps in Win?
filp has joined #ocaml
blackthorne has joined #ocaml
posada_ has joined #ocaml
rby has joined #ocaml
posada_ has quit ["Ex-Chat"]
blackthorne_ has quit [Read error: 110 (Connection timed out)]
OChameau has joined #ocaml
Demitar has joined #ocaml
petchema has quit [Remote closed the connection]
det has joined #ocaml
<det> What alternatives are there to implement back-tracking in OCaml? The only thing I can think of is convert the relevant code to CPS, which seems really suboptimal to me.
ygrek has quit ["Leaving"]
ttamttam has joined #ocaml
petchema has joined #ocaml
pango has quit [Remote closed the connection]
pango has joined #ocaml
Linktim has quit [Read error: 110 (Connection timed out)]
hkBst has joined #ocaml
Linktim has joined #ocaml
yangsx has quit [Read error: 110 (Connection timed out)]
hkBst has quit [Read error: 110 (Connection timed out)]
hkBst has joined #ocaml
sirius6b has quit ["Ухожу"]
<jlouis> det, exceptions! Lots!
yminsky has joined #ocaml
yminsky has quit []
ttamttam has left #ocaml []
ygrek has joined #ocaml
sporkmonger has joined #ocaml
blackthorne has quit []
coucou747 has joined #ocaml
bluestorm has joined #ocaml
nuncanada has quit ["Leaving"]
filp has quit [Read error: 104 (Connection reset by peer)]
filp has joined #ocaml
RobertFischer has joined #ocaml
Poulet has quit []
Demitar has quit [Read error: 110 (Connection timed out)]
postalchris has joined #ocaml
al-maisan has quit ["Leaving."]
al-maisan has joined #ocaml
Kopophex has joined #ocaml
netx has joined #ocaml
netx has quit [Read error: 104 (Connection reset by peer)]
Axioplase has joined #ocaml
Kopophex has quit [Read error: 110 (Connection timed out)]
Axioplase has quit ["leaving"]
Linktim_ has joined #ocaml
al-maisan has quit [Remote closed the connection]
Axioplase has joined #ocaml
filp has quit ["Bye"]
al-maisan has joined #ocaml
jonafan_ is now known as jonafan
al-maisan has quit ["Leaving."]
Linktim has quit [Read error: 110 (Connection timed out)]
al-maisan has joined #ocaml
pango has quit [Dead socket]
pango has joined #ocaml
<struk_atwork> hey all I read one paper on polymophic variants and did not really understand it...anyone got a link they recommend for it/
<Smerdyakov> struk_atwork, did you read the manual?
<struk_atwork> Smerdyakov, I didn't even know it was thoroughly covered in the manual. silly me. I will look for that section
mbishop has quit [Read error: 104 (Connection reset by peer)]
mbishop has joined #ocaml
OChameau has quit ["Leaving"]
<RobertFischer> struk_atwork: Happens to the best of us.
<struk_atwork> RobertFischer, indeed.
delamarche has joined #ocaml
petchema has quit [Remote closed the connection]
jeremiah has quit [Read error: 104 (Connection reset by peer)]
melkart has joined #ocaml
love-pingoo has joined #ocaml
Yoric[DT] has joined #ocaml
delamarche has quit []
delamarche has joined #ocaml
pango has quit [Remote closed the connection]
pango has joined #ocaml
thelema has quit [Read error: 110 (Connection timed out)]
filp has joined #ocaml
RobertFischer has quit ["Taking off -- check out http://smokejumperit.com and http://enfranchisedmind.com/blog/"]
delamarche has quit []
<Yoric[DT]> rwmjones: ping
<rwmjones> Yoric[DT], pong
<Yoric[DT]> Hi.
<Yoric[DT]> Nobody answered my question regarding Enum.init .
<Yoric[DT]> I'd like to know if it's a bug or a feature.
melkart has left #ocaml []
<Yoric[DT]> If it's a bug, I can fix it in my next patch.
<flux> what was the question?
<Yoric[DT]> When one creates an enumeration with Enum.init and then clones it, the underlying function will end up being evaluated several times.
<bluestorm> is it fixable while preserving the relative lazyness of Enums ?
al-maisan has quit ["Leaving."]
pango has quit ["I shouldn't really be here - dircproxy 1.0.5"]
<Yoric[DT]> Yes.
pango has joined #ocaml
<Yoric[DT]> This requires a little bit of lazy lists behind the hoods.
<Yoric[DT]> (or perhaps something else, say queues)
<Yoric[DT]> but it's feasible.
<Yoric[DT]> Actually, I have a prototype fix.
Poulet has joined #ocaml
<coucou747> 42
<rwmjones> Yoric[DT], I tend to avoid Enums ...
<Yoric[DT]> Why is that ?
<palomer> err, I want to write a string to a file and extract a string from a file
<palomer> what functions should I look at?
<Yoric[DT]> input_line / output_line
Snark has joined #ocaml
<Yoric[DT]> both in module Pervasives
<palomer> oh, I meant binary data
<Yoric[DT]> input_byte / output_byte ?
<Yoric[DT]> input_binary_int / output_binary_int ?
<palomer> input_value, output_value !
<palomer> how does marshal know how much to read?
<orbitz> are the binary_int funcs meant to work between achsrchs?
<pango> what about output and in_channel_length + really_input ?
<Yoric[DT]> palomer: magic
<palomer> marshal stores the size in the file:P
<palomer> you can't trick me!!!
<Yoric[DT]> :)
* Yoric[DT] isn't that sure, actually.
<pango> marshal is not type safe however
<palomer> that's ok!
<pango> then output_value / input_value
<Yoric[DT]> Ok, I've just uploaded the replacement enum.ml .
Linktim_ has quit [Remote closed the connection]
filp has quit ["Bye"]
coucou747 has quit [Remote closed the connection]
thelema has joined #ocaml
coucou747 has joined #ocaml
postalchris has quit [Read error: 110 (Connection timed out)]
<flux> hm, does batteries come with a date/time library?
<hcarty> If it doesn't, OCaml Calendar is nice
<flux> well, maybe not
<flux> I have one ocaml-calendar based piece of software in the cron..
<flux> it fails every day between 00 and 03, each hour
<flux> :)
<flux> I think it's because I'm UTC+3
<flux> ..perhaps I should atleast file a bug report..
<flux> but, off to sleep &
<hcarty> That's strange. I've never had a problem like that, but I am not manipulating local times, just timestamps on data
<mbishop> I translated (never finished) some CL code for dates into Scheme...it does all kinds of stuff though, julian, gregorian, hebrew, islamic, even mayan calculations and stuff
<mbishop> might be fun translating to ocaml
<orbitz> is it online?
<mbishop> the original CL code is, not the stuff I converted to scheme though
Snark has quit ["Ex-Chat"]
<orbitz> which is easier to convert you think?
* mbishop shrugs
<mbishop> translating to scheme was almost straight forward
<mbishop> Yoric[DT]: fix your blog so it doesn't just show up as "yoric" on my reader :P
<Yoric[DT]> ?
al-maisan has joined #ocaml
pango has quit [Remote closed the connection]
pango has joined #ocaml
<hcarty> Yoric[DT]: I see something similar with Google Reader - the title for your posts always show up as "yoric"
ygrek has quit [Remote closed the connection]
<Yoric[DT]> mmmhhhh....
ygrek has joined #ocaml
<Yoric[DT]> On my blog or on ocamlcore ?
<hcarty> This is from the ocamlcore feed
sporkmonger has quit [Remote closed the connection]
pango has quit [Remote closed the connection]
pango has joined #ocaml
<hcarty> Yoric[DT]: Have you done any performance comparisons between your modified Enum, the original Enum, for loops, and Sdflow?
rwmjones has quit ["Closed connection"]
sporkmonger has joined #ocaml
love-pingoo has quit ["Connection reset by pear"]
LordMetroid has joined #ocaml
<Yoric[DT]> hcarty: none, I'm afraid.
<Yoric[DT]> Between the modified Enum and the original Enum, the main differences appear when attempting to [clone] a enumeration created with [from], and when creating an enumeration with [init].
<Yoric[DT]> In the first case, I proceed lazily while Enum proceeds eagerly, so comparaisons might be difficult.
<Yoric[DT]> In the second, I assume Enum should be trivially faster, but I haven't checked.
<Yoric[DT]> Checking wrt for loops and Stream/Sdflow seems more coherent.
<Yoric[DT]> Although I've seen how Sdflow handles cloning and, well, let's say that Enum deserves to be faster :)
al-maisan has quit ["Leaving."]
<hcarty> I would hope Enum is faster in general than Sdflow - it has a nice interface, but creating an array or list of n elements then iterating/mapping over that that is quicker than iter/map ... (0 -- n) with Sdflow
<hcarty> For smaller values of n, anyway
sporkmonger has quit [Read error: 110 (Connection timed out)]
<Yoric[DT]> Is that so ?
nuncanada has joined #ocaml
<Yoric[DT]> That's strange.
<Yoric[DT]> SDflow's iter is just Stream.iter
<hcarty> I thought it was strange as well
<hcarty> I think I only tested this in the toplevel though
<hcarty> So compiled performance may be significantly different
<Yoric[DT]> Possibly.
<Yoric[DT]> I'll try and test that someday.
<Yoric[DT]> I should also publish my results for speed-testing exceptions vs. monadic error management vs. monadic exception-based error management.
<bluestorm> then you'll get more complaints about your rss feed :-'
<Yoric[DT]> :)
<Yoric[DT]> I'm afraid I don't know how to change that.
<Yoric[DT]> I'm not even sure whose fault it is.
postalchris has joined #ocaml
<jonafan> surely it's not yoric's fault
<bluestorm> gildor_ won't be working on it until you complain :)
ygrek has quit [Remote closed the connection]
<Yoric[DT]> :)
<Yoric[DT]> Anyway, it's time to call it a night.
<Yoric[DT]> Cheers, everyone.
Yoric[DT] has quit ["Ex-Chat"]
<gildor_> bluestorm: what is the problem
<bluestorm> hm, i'm not sure it's on your side
<bluestorm> in the rss feed coming from the planet, Yoric's blog post get "yoric" as title
<bluestorm> whereas his feeds looks ok
<gildor_> hmmm
Poulet has quit []
bluestorm has quit ["Konversation terminated!"]
<orbitz> palomer: you love your polymorphic variants,
rogo has joined #ocaml
<jonafan> what's going in batteries included?
<jonafan> i want more operators, i write the same operators every time i work with ocaml
<orbitz> put em in a module then?
<jonafan> maybe
LordMetroid has quit ["Leaving"]
<orbitz> ExtLib has a lot of useful thigns
<orbitz> so does Core
<orbitz> i think batteries includd will include a lot of the functionality between the two of htem thouhg
Tetsuo has quit ["Leaving"]
hkBst has quit ["Konversation terminated!"]
<thelema> drat, I just missed yoric.
Demitar has joined #ocaml
Kopophex has joined #ocaml
<gildor_> thelema: once again you ask me for a git repo on forge.ocamlcore.org
<gildor_> since you don't have submit a bug report, i am not sure you still want it
sporkmonger has joined #ocaml
Optikal_1 has quit ["Leaving."]
<thelema> gildor_: apparently I don't want it enough to figure out how to submit a bug report
<thelema> at the moment I seem to have two public repos - I don't see much gain in adding a 3rd.
<gildor_> ok, do as you want
<gildor_> (but submitting a bug report is not as complicated as it seems)
postalchris has quit [Connection timed out]
yangsx has joined #ocaml