flux changed the topic of #ocaml to: 3.11.0+rc1 is out! | Discussions about the OCaml programming language | http://caml.inria.fr/ | 3.11.0beta1 available from http://caml.inria.fr/pub/distrib/ocaml-3.11/ | Or grab OCaml 3.10.2 from http://caml.inria.fr/ocaml/release.html
<christo_m> palomer, you sure?
<christo_m> palomer, i guess let i f n (a:int) should do it
<christo_m> it already claims n is an integer based on the inference of the condition testing (n < 0 etc..)
<christo_m> palomer, http://pastebin.com/m2266dbd3 <- theres my new version of it, im still geting an error
<christo_m> This expression has type unit but is here used with type int
<christo_m> for the last else statement
_zack has quit ["Leaving."]
Soulsbane has joined #ocaml
vixey has quit [Read error: 110 (Connection timed out)]
jeddhaberstro has quit []
tomh has quit ["http://www.mibbit.com ajax IRC Client"]
Soulsbane has quit ["Leaving."]
hkBst has quit [Read error: 104 (Connection reset by peer)]
mbtrimpe has quit [Remote closed the connection]
mtrimpe has joined #ocaml
mtrimpe has quit [Read error: 104 (Connection reset by peer)]
mtrimpe has joined #ocaml
mtrimpe has quit [Read error: 104 (Connection reset by peer)]
christo_m has quit [Read error: 104 (Connection reset by peer)]
mtrimpe has joined #ocaml
jeddhaberstro has joined #ocaml
mtrimpe has quit [Read error: 104 (Connection reset by peer)]
mtrimpe has joined #ocaml
mtrimpe has quit [Read error: 104 (Connection reset by peer)]
mtrimpe has joined #ocaml
mtrimpe has quit [Read error: 104 (Connection reset by peer)]
mtrimpe has joined #ocaml
mtrimpe has quit [Read error: 104 (Connection reset by peer)]
mtrimpe has joined #ocaml
Amorphous has quit [Read error: 110 (Connection timed out)]
Amorphous has joined #ocaml
<alexyk> well anyone alive tonight?
<alexyk> I want to use pgocaml access to a table -- read it in -- from toplevel; should I compile and load it in?
jeddhaberstro has quit []
jeddhaberstro has joined #ocaml
jeddhaberstro has quit [Client Quit]
jeddhaberstro has joined #ocaml
fschwidom has quit [Remote closed the connection]
jeddhaberstro has quit []
jeddhaberstro has joined #ocaml
jeremiah has quit [Read error: 104 (Connection reset by peer)]
jeremiah has joined #ocaml
mtrimpe has quit []
pumpkin_ has quit ["Leaving..."]
alexyk has quit []
pumpkin- has joined #ocaml
<flux> people just go, no way to help them afterwards ;)
jeddhaberstro has left #ocaml []
slash_ has joined #ocaml
Camarade_Tux has joined #ocaml
<palomer> hrmph
<palomer> is there a howto on compiling stuff that requires extlib, pcre,gtk, findlib and omake for windows?
<palomer> seems like a HUGE pita
<Camarade_Tux> tried cross-compiling ? =)
<Camarade_Tux> (I've dreamt I could say that for ocaml :) )
<palomer> it scares me
apples` has quit ["Leaving"]
<Camarade_Tux> it only means you've not really tried win32->win32 compilation yet :d
ygrek has joined #ocaml
Snark has joined #ocaml
Gionne has joined #ocaml
slash_ has quit [Client Quit]
_zack has joined #ocaml
<Gionne> http://pastebin.com/m36bed95c what's the problem here?
<Camarade_Tux> Gionne, line 18 : | hd :: tl -> [(el, hd)] :: (add_head el tl)
<Camarade_Tux> why are you using [(el, hd)] instead of (el, hd) ?
<Gionne> uh
<Gionne> i'll try without
<Gionne> didn't see that
<Gionne> thank you
<Gionne> but the error remains the same
<Gionne> btw i think it should be a list
<Gionne> or not?
<Camarade_Tux> maybe [el :: hd] then but I've not read everything and it looks quite weird
<Gionne> thanx the same
<Gionne> it should be a pair
<flux> whee, I patched caml-types to find .annot files from _build (also)
<flux> hm, please don't tell me it's been fixed somewhere else already?
itewsh has joined #ocaml
<flux> indeed, it was fixed atleast in the latest caml distribution, only my ubuntu one was old..
* Camarade_Tux cheers flux up
<flux> thanks ;-((
<flux> gionne, the problem is that (symbol * symbol list list) is different than (symbol * symbol) list list
<flux> or did you already solve it?
<flux> or was that too obvious and not the core of the problem at all?-)
<flux> which one do you want?
<Gionne> no didn't solve
<Gionne> i want the first one
<Gionne> the add_head works add_head "A" l1;;
<Gionne> - : (string * string list) list =
<Gionne> [("A", ["b"; "c"; "d"]); ("A", ["D"; "c"]); ("A", ["B"])]
<Gionne> that's what i want
<flux> that's not a (string * string list list)
<Gionne> that's a (string * string list) list?
<flux> yes
<flux> as it says :)
<Gionne> ok
<Gionne> so it's a parenthesis problem
<flux> so perhaps your grammas has wrong type for Prod?
<flux> grammar, even
<Gionne> i just changed it as you suggest
<Gionne> seems to work
<flux> whee
<Gionne> have to change all the other funcs
<flux> :)
<Gionne> you're my salvation flux
<flux> happy to help
<Gionne> happy to be helped
<flux> you seem to have a relatively ambitious first real ocaml project
<Gionne> yes it is
<Gionne> it's the final boss before degree eheh
marmotine has joined #ocaml
Yoric[DT] has joined #ocaml
snhmib has quit ["Good riddance!"]
sporkmonger has quit []
hkBst has joined #ocaml
marmotine has quit [Excess Flood]
marmotine has joined #ocaml
vixey has joined #ocaml
Gionne has quit ["Leaving"]
tomh has joined #ocaml
middayc has joined #ocaml
zerny has joined #ocaml
Gionne has joined #ocaml
itewsh has quit [Connection timed out]
itewsh has joined #ocaml
<flux> hmm..
<flux> I think I've found a bug in -dannot or caml-types.el..
<flux> at times, when I point to the expression b of f a b, it gives me the type of f a b instead of b
<flux> or, it may be related to camlp4o
<flux> or just the packages I use :). (I suppose it needs further research)
bzzbzz has joined #ocaml
tomh has quit ["http://www.mibbit.com ajax IRC Client"]
Yoric[DT] has quit [Read error: 110 (Connection timed out)]
alexyk has joined #ocaml
tomh has joined #ocaml
itewsh has quit ["KTHXBYE"]
jlouis has quit [Remote closed the connection]
<flux> ocamlbuild is sort of neat while refactoring code. no need to modify Makefiles, or make depend
<vixey> how do you do data recursion in ocaml?
<flux> vixey, what do you mean? define a recursive type?
<vixey> just grout everything with 'lazy'?
mtrimpe has joined #ocaml
<vixey> stuff like ones = 1 :: ones
<flux> well, that's works, but it's a hack
<flux> s/'s//
<vixey> I'm mostly wondering how the packrat algorithm would be done in ocaml
tomh has quit ["http://www.mibbit.com ajax IRC Client"]
<vixey> I got a couple ideas but don't really know what's best
tomh has joined #ocaml
<flux> well, good for you, because you can take a look at one :)
<flux> I wonder where it was at..
<flux> yeah, aurochs
<flux> so aurochs.fr
<vixey> oh great, thanks!
<vixey> so aurochs complies into a kind of stack machine
<flux> btw, autochs has the nice feature that it can convert a file into xml per given packrat parser rules
<flux> so you don't even need a program to see the parsing results
middayc has quit [Read error: 60 (Operation timed out)]
jlouis has joined #ocaml
<alexyk> so I compile a cmo file using pgocaml and #load it; then I change it and recompile and try to #load again, and toplevel says the interface is incompatible to the previously loaded one -- is there a way to unload the first version first?
<flux> I don't think so
<flux> perhaps easier for testing purposes is to use #use "foo.ml"
<flux> which is not quite the same, though
marque has joined #ocaml
snhmib has joined #ocaml
marque has left #ocaml []
sebbu has joined #ocaml
<sebbu> hi
<sebbu> i have to programm the fft for the university, here is my code : http://paste.la/18235 but i got errors on line 15 20 and 26, and i don't know how to fix the 9th line
sporkmonger has joined #ocaml
<sebbu> ( i tried to do the pseudo code of the 30th chapter of "introduction to algorithms" )
<sebbu> ( page 835 )
<Smerdyakov> Please give us the exact text of one error message at a time, and then maybe we can help.
<flux> module A = Array
<flux> in the beginning
<flux> hmm
<flux> no, it was my version ;)
<sebbu> Warning: this expression should have type unit.
<flux> he's trying to do arithmetics on imaginary numbers
<sebbu> flux, i have modules in another file
<Smerdyakov> sebbu, which line is that?
<sebbu> 15
<flux> I've never used them, but there's the module Complex
<Smerdyakov> Does it surprise you that the expression there does not have type [unit]?
<sebbu> what's [unit] ?
<Smerdyakov> You need to read an OCaml tutorial before continuing, methinks.
<sebbu> i did
<Smerdyakov> Which one?
<sebbu> the one of my teacher
<sebbu> but i never used complex before in ocaml
pango has quit [Remote closed the connection]
<Smerdyakov> I suggest finding a "real" tutorial that has broad community support, like the one in the OCaml manual.
<flux> sebbu, is w supposed to be a complex number of float or what?
<sebbu> probably
_zack has quit [Read error: 113 (No route to host)]
pango has joined #ocaml
Galdo has joined #ocaml
<Galdo> hi, is it possible to write a function that creates a function and that modifies the value that this created function will return ? if yes, how can i do such a thing ?
<Smerdyakov> sebbu, it is inappropriate for you to be asking for help if you aren't sure of the answer to flux's question.
<Galdo> or should it be more appropriate to create an assoc list ?
<Smerdyakov> Galdo, sure. Allocate a [ref].
<Galdo> ok, i write : let result = ref (fun n -> 0)
<Galdo> and then, how can i modify the value that result will return ?
<flux> galdo, result := (fun n -> 42). http://caml.inria.fr/pub/docs/manual-ocaml/manual003.html covers this, among other things.
<Galdo> what if i want to add a specific value ?
<flux> ?
<Galdo> result := (fun specvalue -> 12 | n -> !result n) ?
<flux> actually, almost, but you'd use keyword function in place of fun
<flux> in general, of course, you could use match, with possibly guards
<Smerdyakov> That is not quite at my definition of "almost".
<Smerdyakov> That function will loop forever on any input but [specvalue].
<Smerdyakov> And, of course, [specvalue] is interpreted literally as a pattern that will match anything.
<Smerdyakov> So, my conclusion is that Galdo really needs to read a basic OCaml tutorial.
<Galdo> Smerdyakov: thanks i know how to use ocaml, i just don't know how to use ref on function
<Galdo> furthermore, when i write specvalue, i mean a specific value that i will enter literally, as 13, for instance
<Smerdyakov> Galdo, well, please only write real OCaml code, unless you give a clear warning beforehand.
<Galdo> Ok
<Smerdyakov> Galdo, also, there are no special rules for the combination of [ref]s and functions, so you must not understand one or the other at a basic level.
<Smerdyakov> The fact that you didn't realize your suggested [result] definition yields a function that may not always terminate indicates a basic misunderstanding of [ref]s.
<Galdo> i know how to use function, and ref, i just don't know how to say that i want that this function which is on this reference returns 42 for the value 13 ; i'm using ocaml for several years but i never had to do such a thing
<flux> galdo, functions that are behind references are just plain of functions
<Galdo> Smerdyakov: actually i realize, i just wanted to use the old values of !result ; but i saw my mistake
<flux> you can have: let a b = 0 let b c = if c = 0 then 4 else c + 4 let r = ref a let _ = r := ref b (atleast if I wrote no bug there)
<Galdo> r := b you mean ?
<flux> yes
<flux> so the references really don't add anything to this, except the capability to rebind a value
<Galdo> yes i know all that
<Galdo> but how can i say that i want a new function that returns the same value of the old one, but not for the specific value that i want to add ?
<flux> result := let old_fun = !result in fun n -> if n = 42 then 12 else old_fun n
Yoric[DT] has joined #ocaml
<Galdo> yes, my mistake was in not passing through a temp variable
<Galdo> thanks
_zack has joined #ocaml
hkBst has quit [Read error: 104 (Connection reset by peer)]
hkBst has joined #ocaml
<alexyk> anyone tried to get column names with pgocaml?
<flux> alexyk, what would you do with that?
<alexyk> flux: I generate tables with column names matching values in ocaml program, to access
<flux> hmm..
<flux> alexyk, so you have a database table you want to generate ocaml information, or ocaml code from which you want to generate database tables?
<flux> in general one would avoid SELECT * FROM .. kind of queries, but I suppose it's ok if you really look which names you get
<flux> but I suppose pgocaml could support them. does it?
<alexyk> flux: I generate columns in postgres with names such as "2004-10-01" for timed data; I may generate more; then I do select * from it in ocaml
<alexyk> then I may give ocaml program a comman-line param like "2004-10-01" to use the right column
<flux> uhh..
<alexyk> I don't want to repeat column names in ocaml
<alexyk> usually db drivers let you query metadata from tables;
<flux> I'm not sure if pgocaml works for that. the way I understand pgocaml works, you'd need to recompile the program after each such change
<flux> in general, in relational databases, the structure of the database is supposed to be static
<alexyk> Dario Teixeira told me one can do almost anything which pg can do via pgocaml, but I don't see it in pGOCaml.mli
<alexyk> flux: sure, I can recompile easy, I don't want to retype
<alexyk> it checks at compile time, but fetches column types itself
<flux> alexyk, well, I believe you may be able to find the column names from a special postgresql table
<flux> but form which table, that I don't know
<alexyk> flux: aha! probably
<Yoric[DT]> From my recollections of SQL, calling a column "2004-10-01" sounds like there has been a design error somewhere.
<flux> I imagine retrieving the column names from a response would also be possible, but I have no idea ig pgocaml supports it
<flux> yoric[dt], my thoughts too
<alexyk> Yoric: works fine :)
<flux> sounds like database design by excel :P
<Yoric[DT]> as you wish
<Yoric[DT]> :)
<flux> hope that wasn't too offensive ;)
<alexyk> it's not for nothing you see SQL names in quotes, they can be called anything
<Yoric[DT]> That's not the issue.
<Yoric[DT]> The issue is storing data inside a name.
<alexyk> I didn't touch Excel with a stick in a while
<alexyk> Yoric: it's in fact data-driven setup, and value of column name matches value of a parameter very well; this makes sense in the app
<Yoric[DT]> ok
<alexyk> I basically concoct a small table from another big one and add columns for dates of interest, only to be matched against a command-line parameter, so it's a quick fix
<alexyk> yeah, if it were a big design, prolly wouldn't do that
<Yoric[DT]> Well, it looks somewhat hackish to me but I'm the first one to admit that my brain and SQL development have some incompatibility issues :)
<Yoric[DT]> (despite of which I'm supposed to teach [My]SQL)
<Yoric[DT]> (sigh)
<alexyk> BTW SQL is a functional language :)
<flux> yoric[dt], be sure to pass this on to your students :P http://monty-says.blogspot.com/2008/11/oops-we-did-it-again-mysql-51-released.html
<alexyk> trying to make SQL do something for you is similar to forcing ocaml do something non-trivial :)
<flux> I would say SQL is more a declarative language
<flux> you say what you want, and the database processor tries to find the answer to you
<flux> there is the functional aspect in it too, though
<Yoric[DT]> Yeah, more declarative than functional.
<flux> but, unfortunately for example higher order functions are nowhere to be seen
<alexyk> flux: well we declare functions, and ocaml must combine them properly to deliver results
<flux> alexyk, but you will always know what ocaml does
<alexyk> or I meant Haskell, never mind
<alexyk> :)
<flux> but you can't know what the database system does
<flux> it may choose to use an index or not
<alexyk> flux: right...
sebbu2 has joined #ocaml
apples` has joined #ocaml
sebbu has quit [Read error: 60 (Operation timed out)]
sebbu2 is now known as sebbu
olgen has joined #ocaml
apples`` has joined #ocaml
apples` has quit [Nick collision from services.]
apples`` is now known as apples`
jeremiah has quit [Read error: 104 (Connection reset by peer)]
alexyk has quit []
jeremiah has joined #ocaml
<flux> am I missing something completely obvious, or doesn't Lwt provide Event-like facilities?
pumpkin- has quit ["Leaving..."]
<flux> also Lwt doesn't seem to have the concept of a thread or task.. I suppose it doesn't need one, though, but it feels convenient to me :)
<olegfink> how does one debug an ocamlyacc-generated parser?
<Smerdyakov> olegfink, re: what kind of bug?
<flux> I believe it has some debug support
<flux> providing debug output and intermediate state information
<flux> I don't remember how they work, but they're described in the documentation
<olegfink> Smerdyakov, wrong behaviour
<flux> also, menhir says it can produce human-readable diagnostics, but I don't know more about that either ;)
<Smerdyakov> olegfink, find the smallest example that shows the bug and stare at it. You have a nice declarative specification, and you get error messages if you create ambiguity, so you shouldn't need any special tool support.
<olegfink> sure that's the best kernighan-style method of debugging, but with a relatively (for my second day of using (ocaml)yacc) huge grammar factoring out the smallest working portion which still contains the bug is itself a problem
<Smerdyakov> No, the smallest _input_string_.
<Smerdyakov> Not the smallest grammar
<olegfink> heh, a?b:c doesn't seem to be big, but doesn't really give me any insights.
<Smerdyakov> Try to parse it manually.
<olegfink> 1?b:c works, but ?: is defined in terms of expr which is either a literal or an indentifier, so if something would fail here I'd say it's lexing.
middayc has joined #ocaml
<olegfink> anyone willing to take a look at the grammar and probably tell me that that's not how I whould implement a "?:"?
middayc has left #ocaml []
<Smerdyakov> It's a tiny input. You should be able to run all of lexing and parsing in your head.
<olegfink> I do, and I succeed.
<olegfink> (which means I have no idea of how yacc works)
<Camarade_Tux> olegfink, if you run it in bytecode, you can use set OCAMLRUNPARAM to "p" to get debug info
Koordin has joined #ocaml
jeremiah has quit [Read error: 104 (Connection reset by peer)]
<olegfink> oh, cool, thanks
<Camarade_Tux> it helped me earlier today =D
<olegfink> yay, that really helped
<olegfink> ...and you know what?
<olegfink> it would fail _only_ with c at the end
<olegfink> any other string would work.
<Camarade_Tux> well, let's be optimistic : the bug could have gone completely unnoticed and only appeared at a critical-time ;)
<olegfink> hmm, but I still can't understand _why_ it happens
<flux> I think you would've found OCAMLRUNPARAM, had you just searched for word debug in the ocamlyacc page :P
e has joined #ocaml
e is now known as Guest90117
<flux> (me, not being very helpful)
<olegfink> the bug is because :c is an intepreter directive, but it is defined to appear only at the top!
Guest90117 is now known as eaburns
<olegfink> flux, sorry, it's just too late to employ the think-before-ask strategy :/
<olegfink> | expr QUESTION expr COLON expr { Ternary ($1, $3, $5) }
<olegfink> | CNUM expr{ Collect_nums $2 }
Galdo has quit [Read error: 110 (Connection timed out)]
<olegfink> CNUM is in cmd which is in toplevel, ternary is in expr
<olegfink> _how come_ it fins a CNUM halfway after in place of expr?
jeremiah has joined #ocaml
eaburns has quit ["leaving"]
<olegfink> op : expr QUESTION expr . COLON expr (33)
<olegfink> (from ocamlyacc output)
<olegfink> what does dot mean?
<olegfink> ah, dot is current position in a rule
<olegfink> okay, now I've got a complete question
<olegfink> I have two lexer rules
<olegfink> | ':'{ COLON }
<olegfink> | ":c"{ CNUM }
<olegfink> ocamllex prefers the latter for some reason, how do I ask it to prefer the former?
jeremiah has quit [Read error: 104 (Connection reset by peer)]
alexyk has joined #ocaml
bjorkBSD has joined #ocaml
bjorkBSD has left #ocaml []
<flux> hmm..
apples` has quit ["Leaving"]
<olegfink> (and in my understanding parser should ask lexer to reparse, no?)
<flux> I'm not sure if ocamlyacc does those things
<flux> why would lexer ever reparse anything, it just gives the next token?
<olegfink> I could do it with parse_error, but that seems really awkward
Snark has quit ["Ex-Chat"]
<flux> you could perhaps try something like | ":" foo { .. } foo: { .. } | "c" { .. } ?
<Camarade_Tux> olegfink, tried with ":" instead of ':' (and maybe change the order the patterns are written in)
<Camarade_Tux> ?
<flux> ooh, right, lexer
<flux> never mind
<olegfink> both do nothing
<flux> well, the lexer always chooses the longest matching rule
<flux> but, there is a lexer for ocaml that can choose the shortest too
<flux> ah, never mind, ocamlex can do that :)
<flux> "The parse keyword, can be replaced by the shortest keyword"
<flux> but I do wonder if its usage will lead into other problems
<olegfink> oh, right, forgot about that
<olegfink> hmm, neither does shortest work
<olegfink> ah, yes, it makes everything really bad
<olegfink> so I have two possibilities: change :c to something like #c or define ?: exactly as in ansi c (which isn't just expr '?' expr ':' expr)
<vixey> no
<flux> I'm thinking the latter is a good idea anyway?
<olegfink> my grammar is much simpler
<olegfink> I don't know if it's essential to implement everything the same way (seems overcomplicated)
jeremiah has joined #ocaml
<Camarade_Tux> olegfink, what are you parsing ?
<Camarade_Tux> (I have had this page opened in my browser since yesterday...)
<flux> perhaps you can understand it if you take the specification of LALR grammars and thought it through with that structure
<olegfink> Camarade_Tux: just a random c-like calc with variables and logic
Koordin has quit [Operation timed out]
<Camarade_Tux> ok, completely different from what I'm doing (parsing C to write library bindings, but the program is completely dumb)
<flux> camarade_tux, how come not to choose some existing parser? or have we had this chat already ;)
Koordin has joined #ocaml
<Camarade_Tux> flux, we already had ;)
<Camarade_Tux> cil is not what I need, yacfe doesn't have documentation
* olegfink has the temptation to just throw the ?: away. After all, I don't really need it: a?b:c = a*b + !a*c
<flux> olegfink, do you have lazy evaluation?
<vixey> olegfink, I think that's a bad idea
<flux> a = 0 ? 0 : b / a
<Camarade_Tux> I actually started with yacfe but the lack of documentation made it very hard to use (I managed still), especially, several types were named type1, type1_bis, type1_bis2, ...
<flux> (or is /0 just NaN)
<olegfink> it's Divizion_by_zero, so you're right
<olegfink> and no, it's eager.
<olegfink> (but maybe I should make it lazy someday)
<Camarade_Tux> (and after that, I'll finish my music player, I really want to kill audacious, 20% of a core2 to read some .ape file...)
<olegfink> is it mad (or how it's called) or the player itself?
<Camarade_Tux> there are ocaml bindings to a lot of decoders, all I'll be doing is interfacing to them, I'm not completely crazy (and I don't have enough time ;) )
<olegfink> I meant, what does eat the cpu?
<Camarade_Tux> oh, actually .ape decoding is painful on unices so I'll maybe write something, or dream I write something :)
<flux> what is .ape?
<Camarade_Tux> audacious + ape, audacious is a monster, ape decoding is cpu-heavy
<flux> audacious itself does consume unhealthy amounts of cpu, compared to xmms doing the same task
<Camarade_Tux> ape is a lossless music compression format (Monkey's Audio)
<flux> but, xmms is no longer maintained, hasn't been for a few years
<Camarade_Tux> but it recently went back into slackware !
<flux> so slackware has gtk 1.2?
<flux> (that was a rhetorical question ;))
<Camarade_Tux> 1.2 *and* 2 ;)
<Camarade_Tux> actually I should try goggles : http://code.google.com/p/gogglesmm/ :)
itewsh has joined #ocaml
<Camarade_Tux> I remember audacious *paused* taking 6% of CPU :)
<flux> unfortunately some people haven't fully grasped the concept of asynchronicity
Koordin has quit [Connection timed out]
<flux> but it's not their fault, C makes it so difficult :P
Koordin has joined #ocaml
jeremiah has quit [Read error: 104 (Connection reset by peer)]
<Camarade_Tux> I think audacious coders just haven't understood the concept of "testing"
<flux> but, I wonder what's the point in using C, if you're just going to throw CPU performance away..
<Camarade_Tux> be able to say your program is fast and light ?
jeremiah has joined #ocaml
Koordin has quit [Read error: 104 (Connection reset by peer)]
jeremiah has quit [Read error: 104 (Connection reset by peer)]
alexyk has quit []
marmotine has quit ["mv marmotine Laurie"]
alexyk has joined #ocaml
jeremiah has joined #ocaml
<alexyk> for each row from a database table, I get a tuple -- the length is known at runtime though! is there a way to convert it to a list?
<vixey> yes
<alexyk> vixey: the only thing I did to tuples is to match them and assign them to a fixed list of variables for parts, but how do we do that for unknown length?
<vixey> alexyk, what's the type of this tuple of unknown length?
<alexyk> vixey: Int32 option
<vixey> how is that a tuple
<alexyk> vixey: each element
<vixey> alexyk, what's the type of this _tuple_ of unknown length?
<alexyk> int32 * int32 option * int32 option * int32 option * int32 option *
<alexyk> int32 option * int32 option * int32 option * int32 option *
<alexyk> int32 option * int32 option * int32 option * int32 option
<alexyk> -- I know each specific runtime instance
<alexyk> but need a way to convert it to a list which I'd not type in
<vixey> what
<alexyk> -- I need to convert this to a list without knowing how many elements I have
<vixey> what's the type of the function that gives you that tuple?
<alexyk> vixey: it's coming from a database table; pgocaml types the function
<vixey> what types is the function that gives you the tuple that pgocaml types?
<alexyk> vixey: it has that very return type as above; from unit
<vixey> so write int32 * int32 option * int32 option * int32 option * int32 option * int32 option * int32 option * int32 option * int32 option * int32 option * int32 option * int32 option * int32 option -> int32 option list
<alexyk> vixey: I don't write that since I might add another column to the table, and recompiled pgocaml module will change the tuple size automatically
<alexyk> I need a solution for a general tuple size, if any
<vixey> You do not need a solution for any tuple size
<alexyk> vixey: generally speaking, I do
<olegfink> you can do something like Array.to_list (Obj.magic tuple)
itewsh has quit ["KTHXBYE"]
<olegfink> (because tuples are almost arrays)
<olegfink> but that's unsafe
slash_ has joined #ocaml
<Camarade_Tux> the first element of the tuple is int32, not int32 option so that probably won't work anyway
<alexyk> Camarade_Tux: correct
<olegfink> ah, yes.
<alexyk> but I can change it back to option by dropping NOT NULL on the column
<alexyk> so would it work for any element types of the tuples?
<alexyk> meaning non-numeric such as 'a option?
<Camarade_Tux> alexyk, but how does pgocaml change the tuple size automatically ? it could be a good source of ideas
<alexyk> Camarade_Tux: pgocaml has to be recompiled, and it uses camlp4
<olegfink> Camarade_Tux: you can drop the head and cast the rest, but it's really better to see what pgocaml does
<alexyk> the problem is, normally you want a tuple and you know its size, except when you use select * from table and the table contains dynamically added columns
<olegfink> dynamically added? camlp4-generated sources are static.
jeddhaberstro has joined #ocaml
<alexyk> olegfink: youre supposed to recompile, as I mentioned
<olegfink> in fact, the tuple may contain values of arbitrary types, right?
<olegfink> so generally there is no way to represent it as a list
<alexyk> olegfink: your example works fine, thx! I know that ideally I must extend pgocaml to return a row as a list in case we ask select *, but now have no time for that
<alexyk> I am guaranteed to have int32 option columns, just their number can differ
<alexyk> so your solution works well
<vixey> no time for that?
<vixey> So you're using Obj.magic with no clue whether or not it works
<vixey> That seems pretty stupid
<alexyk> vixey: works very well for my scripting purpose
<alexyk> already checked
<alexyk> i.e. have a pretty good clue (result)
<alexyk> but I admit extending pgocaml would be better
<vixey> alexyk, I guess you can't have very much programming experience at all if you think a successful test means your program works
ygrek has quit [Remote closed the connection]
<alexyk> vixey: enough experience to know which battles to choose -- I generate my own table, my own pgocaml glue, and my own conversion
<alexyk> my program works in all possible ways it can be used -- by me, for me
<alexyk> but generally you're correct of course
<olegfink> heh, haskell also has Obj.magic, it's Unsafe.Coerce.unsafeCoerce, but seems I can't think of any interesting uses of it
pumpkin_ has joined #ocaml
<vixey> olegfink, LogicT has a reasonable use of unsafeCoerce
<vixey> in the prompt implementation
<vixey> (note that it is not casting a tuple into an array)
<olegfink> Prelude Unsafe.Coerce> (unsafeCoerce (1,2,3)) :: (Int, Int)
<olegfink> (1,2)
<olegfink> hehe, I can shrink tuples
<pumpkin_> wow
<olegfink> vixey: thanks, will look
<pumpkin_> can you expand them?
<olegfink> yes, I can expand (1,2) to (1,2,Segmentation fault
<pumpkin_> lol
<olegfink> I wonder if the last element hsa the type Int though
<olegfink> s/hsa/has/
zerny has quit [Connection timed out]
Camarade_Tux has quit ["Leaving"]
<olegfink> not that I can't do the same in ocaml, though
<olegfink> # (Obj.magic (1,2) : int*int*int) ;;
<olegfink> - : int * int * int = (1, 2, 2043)
<olegfink> ocaml has found something on the stack(?) and thus survived
<vixey> alexyk, you should definitely take the time to implement this correctly in a type safe way
<alexyk> olegfink: ocaml is a resourceful li'l language
<alexyk> vixey: I'll add it to my pgocaml ideas
<vixey> alexyk, no
<alexyk> vixey: the idea here is that the number of columns is treated as unknown at runtime, so I really need a list from pgocaml, not tuple
<alexyk> until I fix pgocaml, I need a kludge so my own code is correct upstream
<alexyk> I'm not committing to any specific tuple sizes
<alexyk> tuples are wring result for database tables here
ofaurax has joined #ocaml
<alexyk> runtime->compile time, upstream->downstream, wring->wrong
<alexyk> :)
<vixey> alexyk, I can't be bothered trying to understand what you wrote there. You should just take my word for it that what you're doing is idiotic and you should do this the right way instead
<alexyk> vixey: I take your word for it
<vixey> olegfink, in the prompt implementation