sponge45 changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/
zmdkrbou_ is now known as zmdkrbou
shawn has joined #ocaml
postalchris has quit [Read error: 110 (Connection timed out)]
pango_ has joined #ocaml
twobitsprite has joined #ocaml
pango has quit [Remote closed the connection]
smimou has quit ["bli"]
beschmi has joined #ocaml
flux__ has quit [Remote closed the connection]
flux__ has joined #ocaml
erider has left #ocaml []
buluca has joined #ocaml
sponge45 has joined #ocaml
twobitsprite has quit [Read error: 110 (Connection timed out)]
danly has quit ["Leaving"]
mbishop has quit [Remote closed the connection]
Submarine has joined #ocaml
postalchris has joined #ocaml
ikaros has quit [Read error: 110 (Connection timed out)]
sponge45 has quit ["zzzzzzzzzz"]
ikaros has joined #ocaml
jordan has joined #ocaml
<jordan> I know that in lambda-calculus, you can define a function that determines if a number is the church numeral '0' as follows: \lambda x.x (\lambda y.false) true -- where false and true are defined as usual. is it correct that this would be the function that determines whether a number is '1'? -> \lambda x. x (\lambda y.\lambda z false) true true ?
<Smerdyakov> I suggest that you try typechecking it.
<jordan> how?
<jordan> plus would type checking guarantee correctness?
__mattam__ has joined #ocaml
<Smerdyakov> In this case, your inability to typecheck it will guarantee incorrectness. :)
<Smerdyakov> Or just run it on some example inputs.
<jordan> i thought you meant automatically type check. i can just type it into ocaml
<Smerdyakov> It's very easy to formalize this in the Calculus of Inductive Constructions with Coq.
<Smerdyakov> Then you have automatic type-checking.
<Smerdyakov> But you would probably be best off trying your term on any input at all. I don't think it works for any argument whatsoever.
mattam has quit [Read error: 104 (Connection reset by peer)]
zmdkrbou has quit [Read error: 113 (No route to host)]
<jordan> it does work
<jordan> let isone = fun g -> ((g (fun y -> fun z -> f)) t) t;;
<jordan> isone one;;
<jordan> isone one;;
<jordan> let one = fun f -> fun y -> (f y);;
<jordan> let one = fun f -> fun y -> (f y);;
<jordan> let one = fun f -> fun y -> (f y);; isone one;; evaluates to - : '_a -> '_b -> '_a = <fun>
<jordan> ack sorry for the duplicates
<jordan> hm. nope.
Submarine has quit ["Leaving"]
__mattam__ has quit [Read error: 104 (Connection reset by peer)]
<jordan> let isone = fun g -> ((g (fun z -> t)) f);; works for 1 and 0, but is wrong when you check it against numbers > 1. don't know how to get it so more than one application of f makes it evaluate to false
zmdkrbou has joined #ocaml
mattam has joined #ocaml
beschmi has quit ["Leaving"]
Eridius has quit [Read error: 104 (Connection reset by peer)]
Eridius has joined #ocaml
mbishop has joined #ocaml
ChoJin has joined #ocaml
postalchris has quit [Read error: 110 (Connection timed out)]
ikaros has quit [Read error: 110 (Connection timed out)]
ikaros has joined #ocaml
Smerdyakov has quit ["Leaving"]
Skal has joined #ocaml
setog3 has quit [Read error: 110 (Connection timed out)]
<shans_home_> pango_: sorry, I missed your question from this morning
<shans_home_> pango_: do you still want to see some code?
jdev has quit [Read error: 104 (Connection reset by peer)]
jdev has joined #ocaml
Mr_Awesome has quit ["...and the Awesome level drops"]
dark_light has joined #ocaml
<dark_light> is there any way to make a recursive closure?
_velco has joined #ocaml
Eriridius has joined #ocaml
Eridius has quit [Read error: 104 (Connection reset by peer)]
slipstream-- has joined #ocaml
slipstream has quit [Read error: 110 (Connection timed out)]
whatsup103 has joined #ocaml
<flux__> with a fix-function
pango_ has quit [Remote closed the connection]
<flux__> ..which goes like let rec fix f x = f (fix f) x
<flux__> also a closure can internally define and use a recursive function
<whatsup103> beren uysing ocaml for a while
<whatsup103> but i still cant read the damn documentation lol
pango has joined #ocaml
<Eriridius> flux__: does that function actually *do* anything, or just recurse forever?
<flux__> eriridius, fix (fun c i -> printf "%d" i; if i < 10 then c (i + 1) else ()) 0
<Eriridius> o_O
<flux__> c could stand for "continue"
<dark_light> flux__, :D
<Eriridius> flux__: it's really hard to wrap my brain around this at 3:43 AM
<dark_light> there are some good docs about the y combinator, but i still can't get it too Eriridius
<dark_light> at least *really* get.. :o
<Eriridius> ok so as near as I can tell, you're basically making it so you have a function (the f in that fix function) which gets passed a curried version of itself..
<Eriridius> and that curried version is itself being passed itself..
<Eriridius> GAH
* Eriridius wonders what actual use this has, because that wacky incestuous function there could easily be done without the weirdness
<Eriridius> in any case, it's long past time since I went to bed
<dark_light> Eriridius, it can modify the inner recursion of a complex recursive function
<dark_light> without modifying the recursive function itself
<Eriridius> ok, I'm not going to even try and decipher that at this time
<flux__> I suppose it's still nice to be abl-e to detect that pattern and grasp what it means, without the need to think it through
<flux__> the inner function itself is almost the only thi ng required to see what the end result is..
<dark_light> it can even implement recursion using a iterative discipline, so every language that supports closures supports recursion (i think :E)
<flux__> dark_light, note that fix-function needs to be recursive
<Eriridius> also, if a function's local variables aren't stack-based (which would be one way for it to not support recursion), then it doesn't matter if you have closures
<Eriridius> ok, /me sleeps
<dark_light> flux__, i saw a SML paper that shows an imperative implementation or something like this. (ok, maybe i am wrong :E)
<dark_light> Eriridius, bye! o/
<whatsup103> i am tryign to load the csv file
<whatsup103> but that documentation i still cant get what they mean
<whatsup103> i know its simple but yet i still cant read the docs to well ...........i am used to the styling of c and c++ docs
ChoJin has quit ["This computer has gone to sleep"]
_fab has joined #ocaml
buluca has quit [Read error: 110 (Connection timed out)]
<dark_light> well, what they mean? according to the doc, comma separated values, and you may use Csv.load "filename".. o.O
<dark_light> whatsup103, i can't understand what is your question =)
love-pingoo has joined #ocaml
<whatsup103> lol
<whatsup103> dark_light: a better understaning on how to read ocaml docs :D
<dark_light> whatsup103, this doc is just a nice way of showing the .mli files, i.e., the signatures of defined things (with let)
<dark_light> val columns : t -> int means: "columns is a t->int function"
<whatsup103> i kinda get it but when i start seeing
<whatsup103> fsdf -> val -> cal ->
<whatsup103> im just like wtf
<whatsup103> val load_in : ?separator:char -> Pervasives.in_channel -> t
<whatsup103> dark_light: like that right there
<dark_light> whatsup103, a -> b -> c is the same thing as a -> (b -> c), i.e., if i pass an argument of type a, i will get a b -> c function. or, if i pass two arguments, i will get a value of type c
<dark_light> whatsup103, and ?separator:char is a labeled argument.. http://caml.inria.fr/pub/docs/manual-ocaml/manual006.html
<whatsup103> *cry*
<whatsup103> lol
<whatsup103> after you do something its soo easy i have written alot of ocaml code just learnhing new things in it is tedious
<whatsup103> val load : ?separator:char -> string -> t
<whatsup103> filename : CSV filename.
<whatsup103> like that right there
<dark_light> so..?
<whatsup103> i cant even begin to acknoloedge what im suppose ot do there
<dark_light> whatsup103, you will do Cvs.load "filename" to get a value of type t, or Cvs.load ~separator:';' "fliename" to get a value of type t
<dark_light> i suppose the default separator is the comma, hence the C in Csv
<whatsup103> how can yu tell what the seperator is ?
<dark_light> whatsup103, well, Csv is comma "separated" values
<whatsup103> or tabbed seperated
<dark_light> the doc is just poorly written to don't describe what a separator is
<dark_light> whatsup103, sure! you might want use ~separator:'\t'
<whatsup103> i dont get it ? whats that mean
<dark_light> ? mean "optional argument"
<whatsup103> ooooo
<whatsup103> did not know that
<dark_light> section 4.1.1
<whatsup103> yea i seee
<whatsup103> well that clears a big chunk of things up
<whatsup103> also if i am loading in a .csv file theres 2 options they give there to do it
<whatsup103> whats the best way for loading a .csv file and putting it into a list so i can manipulate and print back out ?
<dark_light> well, maybe Csv.load
<dark_light> whatsup103, without seeing the actual implementation, i can not tell
<whatsup103> i mean whats the difference between load and load_in
<whatsup103> ooooooooo
<whatsup103> nevermind
<dark_light> :)
<whatsup103> well
<whatsup103> looks like one loads a file
<whatsup103> and one loads a input file stream
<dark_light> yes
<whatsup103> so if i have the .csv file in the same dir as my script ........looks like regualr Csv.load will work
<dark_light> yes..
<dark_light> whatsup103, i think you should print using Csv.print
<whatsup103> why print
<whatsup103> i need to load it first
<dark_light> well, you said "and print back out"
<whatsup103> ok
<whatsup103> worded it wrong
<whatsup103> i will be taking this CSV file
<whatsup103> and dumping it into a DB
<whatsup103> ;)
<whatsup103> and i will also have to do a little bit of manipulation with the csv
<dark_light> you may manipulate it without converting to a list
<dark_light> well, i think.
<whatsup103> i can
<whatsup103> how ?
<whatsup103> i dont see that there
<whatsup103> dark_light: I think this is more for making a csv file :D
<dark_light> well, hmm, using the lib you actually can't, the lib don't define processing functions :o but Csv.t is a string list list, so you don't need to call any transformation function to begin working with it
<whatsup103> but yea i need to load it manipulate a few things .........then dump the csv into DB tables
<whatsup103> so you mean manipulate the string list ?
<dark_light> the string list list, yes
<dark_light> you may create a Csv.iter function if you want
<whatsup103> iter?
<dark_light> like the List.iter
<dark_light> for itering all lines of a Csv.t value
<whatsup103> dude im having a hard enough time trying to use the thing ...........not mentioning developing for it
<dark_light> hahaha ok..
<dark_light> but i can't imagine this lib without a iter function, that's it
<dark_light> or map
<whatsup103> so once i load it as a string list then i would just take everything out of the strong manipulate it somehow and throw it all together with a mysql query ?
<whatsup103> << doesnt even know what iters is
<whatsup103> i havent done any list in ocaml ............other langs very little though basic stuff
<whatsup103> just network and gui programming
<whatsup103> :(
<whatsup103> this is alot harder then it osunds lol
<dark_light> whatsup103, well, lists are the basic thing in ocaml, and forget it, without handling well with the "weird" things of ocaml will you have no use for it (i am just addicted to iter functions, that's it :)
<whatsup103> i dont even know what an iter function is lol
<dark_light> ah
<whatsup103> lol
<dark_light> List.iter print_endline ["a"; "b"; "c"];;
<whatsup103> im guessing its better then using a list
<dark_light> type this in toplevel
<whatsup103> yea?
<dark_light> :)
<whatsup103> a
<whatsup103> b
<whatsup103> c
<dark_light> this is a iter function
<whatsup103> i mean whats its actual purpose though
<dark_light> it substitutes the C for() with a more-nice-than-anything way of iterate over things
<dark_light> well, nicer
<whatsup103> so what would be the best method to load a csv file
<whatsup103> and
<whatsup103> manipulate a few things
<whatsup103> and then dump into a DB
<dark_light> whatsup103, hmmmm well look this: List.map (fun x -> ":" ^ x) ["a"; "b"; "c"];;
<whatsup103> prints out a strong
<whatsup103> returns
<dark_light> no, process the list, returning a modified list
<whatsup103> ooooooo
<dark_light> (fun x -> ":" ^ x) is applied to every item of the list. it seems a nice way to modify a list :-)
<whatsup103> basically
<whatsup103> for this theires really no modifying for this csv
<whatsup103> just taking cvs
<whatsup103> and dumping it into a mysql DB
microcape has joined #ocaml
<whatsup103> each csv colum will deserve its own mysql tabl colum as well
<dark_light> you may create a function that takes the Csv.t value and do the job (it's a string list list, not a string list)
<whatsup103> whats the difference?
<dark_light> it's a list of rows. each row is a list of strings
<dark_light> so it's a (string list) list
<whatsup103> oooooooooo
<whatsup103> so i could take each row
<whatsup103> and dum pthem individually into a mysql DB
<dark_light> yes. for this you may use List.iter
<whatsup103> ah ha
<whatsup103> :)
<dark_light> or a recursive function,
triple_ has quit [Read error: 110 (Connection timed out)]
<dark_light> or a (argh!) for
<whatsup103> or a loop
<whatsup103> im not a big fan of recursive functionsa
<whatsup103> i have done to much C for that
<dark_light> whatsup103, maybe you should write this app in a language you are more used to
<whatsup103> then it wouldnt be as fun
<dark_light> ahaha:)
<whatsup103> i made my im client in Ocaml :D
<whatsup103> it turned out well
<whatsup103> after a long time :D
<whatsup103> just alot of trial and error and alot of network programming
<whatsup103> i still want to modifu the gui a little more though
<dark_light> ah you are the.. the.. the one at rio (i always forget your nick)
<dark_light> (you seems to changed it to whatsup103 permanently)
<dark_light> whatsup103, gui and network programming seems to be two things ocaml isn't sooo good. i am suffering to make a "easy-to-understand" network code (and i want it far way of my actual processing code)
<whatsup103> lol
<whatsup103> i didnt exactly chnage i just dont have a perment thing
<dark_light> whatsup103, i think if you can't find recursion intersting, you will not have good times with ocaml :( ocaml is very about how recursion is nice (well, it's just my option)
<whatsup103> well
<whatsup103> my professor seems to differ with you :D
<whatsup103> my professor calls it the universal language
retybok has joined #ocaml
<dark_light> i think it is just wrong, really :D writing imperative-only code in ocaml is very painful for me
<dark_light> s/it/he/
<flux__> dark_light, well, I would still say doing imperative stuff in ocaml is much better than doing functional code in C :-)
<flux__> (or even java)
<dark_light> hahahahaha :D yeah
<dark_light> flux__, java has functional things?
<flux__> it sort of has closures
<flux__> with finals and local anonymous objects
<flux__> not tail calls, though
<dark_light> really? :o
<flux__> final int c = n + 42; foo(new Runnable() { void run() { kindalikeaclosure(); } });
<flux__> maybe, I'm not so sure about java syntax
<dark_light> i though it was like C's functional pointers (but, well, mm, i think java has no pointers)
<flux__> (you can access only 'final' variables in the method)
fnf has joined #ocaml
fnf has left #ocaml []
<dark_light> whatsup103, take a look at this: http://nopaste.tshw.de/11660922302a6a8/ , you may use rows_to_cols (Csv.to_array yourcsvvariable) and then you will have a array with the columns, making it easier to write the columns to somewhere
<dark_light> (well, maybe rows_to_cols (Csv.to_array (Csv.square cvs)) :t)
<whatsup103> dark_light: yea
<whatsup103> dark_light: will be cool once i get my csv DB dumper done
<dark_light> when i get a "inconsistent assumptions" error, is there an easy way to see the actual assumptions?
<dark_light> my error is "The files data.cmi and do.cmi make inconsistent assumptions over interface Data"
<flux__> no
<flux__> I think they are basically differing md5-digests
<flux__> so: make clean :)
<flux__> or fix your dependencies (ocamldep is a great tool for that)
<dark_light> ok, ahahahaha, @.@
<dark_light> (btw, how you figured i am using makefiles?)
<dark_light> ps: yea great tool :o
<flux__> I've seen the problem myself ;-)
<flux__> I just assumed you used makefiles..
<dark_light> hmm, if it's possible to verify makefile dependencies with ocamldep, i will put this on my makefile.. my problem was simply being too lazy to add all depends on a file (and, maybe i should really start to use ocamlmakefile..)
<flux__> depend:\n\tocamldep -byte *.ml > .depends\n\ninclude .depends ?
<dark_light> i have no -byte here
<dark_light> flux__, i meant something like do.cmo : `ocamldep do.ml`
<dark_light> maybe using variables..
ikaros has quit [Read error: 110 (Connection timed out)]
<flux__> oh..
ikaros has joined #ocaml
<flux__> I never thought of doing if that way
<flux__> but I suppose it stays in sync a lot better
<dark_light> well, ocamldep do.ml|sed '/[^ :]\+.cmx/d; s/^[^ :]\+: //'. maybe i can store it in a variable..
<flux__> (albeit it's slightly (?) slower)
<flux__> ah, actually I mixed it to ocamldsort
<flux__> which is another great tool ;-)
<dark_light> flux__, speed actually isn't a concern =)
<dark_light> and, a third part one? hmmm
<flux__> ocaml is quite safe anyway, regarding dependencies, as your error revealed
<flux__> so I can just do make clean (or re-make depends) every time I see the problem
<flux__> not so with C :-)
<dark_light> what exactly is a unmet dependency?
<flux__> your file depends on foo, but foo doesn't exist and it doesn't know how to make it
<dark_light> hmm ah i need to say all files to ocamldsort
<flux__> oh, right, ocamldsort said that
<flux__> but that's the problem anyway
<dark_light> ps: ocamlc $(ocamldsort *.ml), never though doing this that way.. but hmm i like to separate different things
<flux__> it's intended to be used like: program: $(ocamldsort -byte *.ml)\n\tocamlc -o $@ $<
<flux__> but you still need dependencies
triple_ has joined #ocaml
<dark_light> ah :)
<dark_light> i may use $() in Makefile ?
<flux__> right, I didn't even see that you used the wrong notation :)
<flux__> in real code I actually have this line:
<flux__> MAIN_CMO_FILES=$(shell < depend ocamldsort -byte $(MAIN_SOURCES))
<flux__> and MAIN_SOURCES is a hand-maintained list of .ml-files
<flux__> (I produce multiple binaries from the sources in the directory)
<dark_light> Hmmmm
<flux__> and then I have main: $(MAIN_CMO_FILES)
<flux__> ocamlfind ocamlc -o $@ -linkpkg $(FLAGS) $(PACKAGES) $^
<flux__> ..and again depend-rule goes like depend:\n\t(ocamlfind ocamldep $(PACKAGES) $(MAIN_SOURCES)) > depend
<dark_light> DO_DEPS=$(shell ocamldep do.ml|sed '/[^ :]\+.cmx/d; s/^[^ :]\+: //')
<dark_light> very very nice :)
<dark_light> but i have a file, lib.cmo, that i actually compile as lib.cma (the unique difference seems to be don't compile what isn't used), i think i will have to substitute it on hand..
<dark_light> (ok, ahah, actually this don't works)
<dark_light> ok, i will make a script do do this pipe..
microcape has quit []
<flux__> has anyone seen a camlp4-module which would provide __FILE__, __LINE__ and __FUNCTION__ ?
<Eriridius> I'm curious, what do people here use ocaml for?
<flux__> for fun (little tools), lately for some work (networking, databases)
priich has quit [Read error: 110 (Connection timed out)]
postalchris has joined #ocaml
<flux__> pango, annotatory produces some nasty output for a language extension..
<flux__> just a short copy of its output: (((((Pcaml.expr:(string option * Gramext.g_assoc option * (Token.t Gramext.g_symbol list * Gramext.g_action) list) list):string option * Gramext.g_assoc option * (Token.t Gramext.g_symbol list * Gramext.g_action) list):(Token.t Gramext.g_symbol list * Gramext.g_action) list):Token.t Gramext.g_symbol list * Gramext.g_action):Gramext.g_action):MLast.expr -> '_a -> MLast.loc -> MLast.expr):'_a -> MLast.loc -
<flux__> (I won't even start to decipher that..)
<retybok> is this by any chance the right place for f#?
<flux__> maybe, although I don't think anyone here uses F# :-)
<retybok> flux__: thanks
love-pingoo has quit [Remote closed the connection]
love-pingoo has joined #ocaml
asm has joined #ocaml
ppsmimram has quit ["Leaving"]
ppsmimou has joined #ocaml
<flux__> is there a way to get the current top-level function in camlp4?
cypher256 has left #ocaml []
jordan has quit ["This computer has gone to sleep"]
<flux__> hmm.. would one need to define a custom camlp4 parser to grab the top-level definitions' locations, and use that info?
<flux__> that can become very difficult..
<flux__> I was thinking maybe I could use Pcaml.print_implem = .. to place my parser of the input tree, but it doesn't get called
velco has joined #ocaml
smimou has joined #ocaml
buluca has joined #ocaml
ChoJin has joined #ocaml
danly has joined #ocaml
velco has quit ["Ex-Chat"]
love-pingoo has quit ["Leaving"]
Aradorn has joined #ocaml
gunark has joined #ocaml
<holdenk> For a project that I'm working on I'm trying to parse a large number of languages and I was wondering which parser generators people would recommend [ocamlyacc,elkhound,etc.] (and why).
Smerdyakov has joined #ocaml
Eriridius is now known as Eridius
ChoJin has quit ["This computer has gone to sleep"]
asm has quit ["Verlassend"]
<flux__> there were a couple for ocamol.. I've used menhir. however, wasn't elkhound the most generic parsing-wise? you might appreciate that if you want to write code to parse something with the least amount of work..
oip has joined #ocaml
oip has quit ["..."]
<Smerdyakov> It's a feature, not a bug, not to be able to handle languages beyond what yacc does. They're too complicated. :P
_velco has quit ["I'm outta here ..."]
<holdenk> flux__: thanks.
bluestorm has joined #ocaml
love-pingoo has joined #ocaml
stevan__ has joined #ocaml
klapmuetz has joined #ocaml
stevan_ has quit [Read error: 110 (Connection timed out)]
klapmuet1 has quit [Read error: 145 (Connection timed out)]
Axioplase has joined #ocaml
<Axioplase> Hi
<Axioplase> I'm coding closures in ml. I have some trouble with the recursive functions... a closure k of recursive function foo is <param, env U (foo,k) ,body>
<Axioplase> however, I've never succeeded in having the env inside the closure hold a ptr to itself...
<Axioplase> I've unsuccessfuly tried sutff like "let rec me = Clos(x, (Env.add foo me env), body)", also with references and so on
<Axioplase> Each time I have a This kind of expression is not allowed as right-hand side of `let rec'
<Axioplase> So if someone could show me a way to do that... my brain's melt for huors :/
desc has quit [Read error: 110 (Connection timed out)]
Cheery has joined #ocaml
<Cheery> Hi.
<Cheery> What is the logic behind that ocaml syntax? Why is it made totally different from what I've seen before?
<pango> what have you seen before ?
<Cheery> lisp, things similar to C, python, ruby, forth, brainfuck, erlang, haskell style syntax etc.
<Cheery> Basically I hate most of them except maybe lisp and forth. :)
<Cheery> oh well, neither haskell or erlang has a bad syntax.
<pango> well, after having seen so many different things, I don't know what could still surprize me... ;)
<pango> I don't feel ocaml is so much different
<Cheery> I don't know, I have a bit hard to find patterns from code written for ocaml.
<Cheery> Maybe it's just that I'm still yet unfamiliar what everything does in ocaml. :)
<Cheery> Seems there are lots of whistles and bells I've not used to see in that certain form what they appear in this one.
<stevan__> Axioplase: try this "let rec me = function Clos(x, (Env.add foo me env), body) ->"
<bluestorm> hm Cheery
<stevan__> Axioplase: although I am not sure you can refer to the function by name in it's own arguments
<bluestorm> is haskell syntax so different ?
<Cheery> it is.
<stevan__> Axioplase: you might need to write some kind of function generator in order to accomplish that
<stevan__> Cheery: Ocaml is a little closer to SML then Haskell
<stevan__> Cheery: what ocaml code have you been looking at?
<Cheery> I've readed through the manual and seen my friend's code written for it.
<stevan__> Cheery: I found this tutorial (http://www.ocaml-tutorial.org/) really helpful in showing the basic features of OCaml, and allowing me to make the mental leaps from SML/Haskell/LISP/Scheme/etc stuff I already knew
stevan__ is now known as stevan
<Cheery> stevan: seems short for a tutorial, is it tightly packed stuff?
<Cheery> I'll give it a try anyway.
<stevan> Cheery: its good for basics, then starts to get slim, but its well worth the hour or so to read
<stevan> Cheery: after reading this, I felt more confident about diving into the user manual and the Oreilly book
<stevan> and reading library code,... I found ExtLib is a great resource for that
<Cheery> well, if it gives me the pattern about how syntax goes I think it'll be enough for me anyway. :)
<Cheery> Many features introduced in ocaml manual are familiar for me already.
<Cheery> only few things like Functors and such I've not seen elsewhere.
<stevan> Cheery: Functors are from SML actually, but once you get the idea of modules being first class, its a really easy concept to grasp
<Cheery> Ok, if manual does not make any clarification with them, I guess I can ask here for extra information then?
pango has quit ["brb"]
descender has joined #ocaml
pango has joined #ocaml
<Cheery> Or what kind of people here are generally? Do you like to answer to moderately stupid questions?
<bluestorm> if think they're ok
<stevan> Cheery: I am fairly new here myself, so I cant say. But I am happy to share my newly aquired knowledge, just dont hold me to being right all the time ;)
<pango> any question that can receive an intelligent answer is worth asking :)
malc_ has joined #ocaml
microcape has joined #ocaml
stevan_ has joined #ocaml
stevan has quit [Read error: 110 (Connection timed out)]
Aradorn has left #ocaml []
whatsup103 has quit [Read error: 113 (No route to host)]
<Axioplase> stevan_: thanks, I'll try this
<Axioplase> (by the way, Haskell's syntax has great sugar and programmer friendly shortcuts that still let the code be clear and nice)
<bluestorm> hum
<bluestorm> last time i saw haskell code
<bluestorm> i just noticed (\a b -> ...) instead of (fun a b -> ...)
ppsmimou has quit [Read error: 104 (Connection reset by peer)]
<Axioplase> well, I do like that : [(x,y) | x<-[1,2,3,4]; y<-[2,4,5,6]]
<Axioplase> it returns you all pairs possible taken from one element of each list
twobitsprite has joined #ocaml
<malc_> Axioplase: wasn't parallel list comprehension a glasgow extension?
retybok has quit ["Lost terminal"]
<Smerdyakov> malc_, I think that is just a standard list comprehension, and it's in standard Haskell.
<malc_> doubt it
<malc_> Prelude> let a = [(x,y) | x<-[1,2,3,4]; y<-[2,4,5,6]]
<malc_> <interactive>:1:29: parse error on input `;'
<malc_> GHC Interactive, version 6.4.2, for Haskell 98.
<Smerdyakov> He probably meant comma instead of semicolon.
<malc_> huh?
<Smerdyakov> I haven't used Haskell much. Perhaps wait until I download & install GHC for my reply. :)
<Axioplase> Smerdyakov: yes. my mistake
<malc_> , worked though
<Axioplase> malc_: and, well, this notation is roughly the oneline monadic intepretation of the non deterministic monad
<Axioplase> I doubt it's an extension, but I havn't been haskelling for more thant one year.
<malc_> Axioplase: i just revisited my old(only) piece of haskell code. and i think p.l.c. is `| expr | expr'
<malc_> i think i like cleans syntax better, where second '|' becomes '&'
<twobitsprite> does someone mind looking at my ocamlyacc code to help me find my shift/reduce conflicts? http://paste.lisp.org/display/32427
<malc_> lovely name
<twobitsprite> me?
<malc_> mlfuck
<twobitsprite> ahh
<twobitsprite> it's a brainfuck interpreter :)
<twobitsprite> (ever heard of it?)
<malc_> sure
<Axioplase> I have written one once ^^
<malc_> big intercall competitor
<twobitsprite> heh, kinda...
<bluestorm> Axioplase:
<bluestorm> aren't such things doable with camlp4 ?
mbishop has quit [Remote closed the connection]
<malc_> bluestorm: to some extent
<bluestorm> hm twobitsprite
<twobitsprite> any ideas on my shift/reduce conflicts? I can't figure them out for the life of me
<Axioplase> twobitsprite: I'm trying to
<bluestorm> you need ocamlyacc to parse a brainfuck program ? o_O
<twobitsprite> bluestorm: it's a learning exercise...
<twobitsprite> bluestorm: I picked something simple to try to figure out how to use ocamlyacc... and appearantly I'm failing horribly
<twobitsprite> :P
<twobitsprite> Axioplase: thanks :) (sorry, I didn't mean to sound nagging...)
<Axioplase> twobitsprite: what about swapping the two cases of each instruction ?
<Axioplase> (starting from loop)
<Smerdyakov> twobitsprite, you won't understand shift-reduce conflicts if you don't read about parsing... that is, the actual algorithms, not tool interfaces.
<Axioplase> or better, remove the first of each of those cases
<twobitsprite> Axioplase: the tutorial (here:http://plus.kaist.ac.kr/~shoh/ocaml/ocamllex-ocamlyacc/ocamlyacc-tutorial/sec-infix-notation-calculator.html) seems to use similar conventions
<Axioplase> no, wait
<twobitsprite> Axioplase... don't think that'll work
<Axioplase> got it I guess
<Axioplase> | incrs INCR <=> INCR incrs
<twobitsprite> Smerdyakov: Yeah, I'm reading about those as well... I learn best when I have something concrete to work with, so...
<Axioplase> (I had mistaken the caps with the rule)
<twobitsprite> Axioplase: I've tried it that way
<twobitsprite> ahh, I see
<bluestorm> um twobitsprite, the "cmds" seems strange
<Axioplase> because you have a left recursion.. which is.. well.. bad (?)
<Axioplase> (though YACC should handle it quite well, but it complains)
<twobitsprite> bluestorm: how so?
<bluestorm> hm
_fab has quit [Read error: 110 (Connection timed out)]
<bluestorm> cmds: { [] }
<bluestorm> | command cmds { $1 :: $2 }
<Axioplase> plsu I don't think you need an action for loop
<twobitsprite> if there's nothing, return an empty list, otherwise build a list of 'cmd' :: 'more cmds'
<Axioplase> you duplicate it because of $1 in loop, and $1::$2 in cmd
<bluestorm> twobitsprite:
<bluestorm> hm
<bluestorm> actually it's ok
<twobitsprite> Axioplase: I wanted to put loops as lists themselves
<Axioplase> try this : | LBRKT cmds RBRKT { Mlfuck.Loop $2 }
<twobitsprite> ahh, I see
<Axioplase> and remove the loop rule
<twobitsprite> I guess that is a bit reduntant
<twobitsprite> doesn't change the number of conflicts :P
<Smerdyakov> twobitsprite, your grammar has an outright ambiguity.
<twobitsprite> Smerdyakov: where?
<Smerdyakov> twobitsprite, you probably didn't mean to use INCR for the base case of decrs.
<twobitsprite> Smerdyakov: that helped :)
<twobitsprite> now I have no reduce/reduce conflicts, but I have gained a shift/reduce conflict :)
<Axioplase> Smerdyakov: nice shot :)
<Smerdyakov> twobitsprite, did you post the error information?
<twobitsprite> (0) mlfuck $ ocamlyacc mlfuck_parser.mly
<twobitsprite> 6 shift/reduce conflicts.
<twobitsprite> that's all it says
<Smerdyakov> Look at mlfuck_parser.out.
<Smerdyakov> It might be .output.
<Smerdyakov> Some file ending in .out* or .desc. :)
* Smerdyakov gets confused between ml-yacc and ocamlyacc.
<twobitsprite> there's a .mli file
<twobitsprite> and a .ml
<Smerdyakov> Maybe you need to trigger a verbosity option.
<bluestorm> is there not a --verbose option ?
<bluestorm> or -v
<twobitsprite> -v doesn't saying anything new
<twobitsprite> yeah, it's not very helpful, is it?
<twobitsprite> so, it seems to produce a parser... so maybe it automatically resolves s/r conflicts, and just warns you about them?
<twobitsprite> also, it doesn't give an error code (return code is 0)
<Smerdyakov> What you want is an additional file with the parsing table.
<Smerdyakov> Not anything printed or any error code returned
<twobitsprite> so, something other than the .ml and .mli that it produces?
<Smerdyakov> Did you read what I said earlier about file extensions?
<twobitsprite> about the .out/.desc thing?
<Smerdyakov> Yes.
<twobitsprite> yeah... I don't see anything like that
<twobitsprite> none of the ocamlyacc tutorials have mentioned anything about those...
<Axioplase> twobitsprite: if you want no more reduce/shift conflicts, write your own recursive descendant parser.
<Axioplase> it teaches quite a lot...
<twobitsprite> ohh wait
<twobitsprite> I see a .output from the -v option :P
<twobitsprite> (sorry, missed it)
<Axioplase> you maight want to glance at http://pauillac.inria.fr/~fpottier/menhir/menhir.html.en too
<twobitsprite> Axioplase: I thought recursive-decent wasn't the same as LALR...?
<twobitsprite> recursive-decent is for LL parsers, right?
<Axioplase> LALR is Look Ahead
<Axioplase> yeah.
<twobitsprite> right... it's a Look-Ahead LR parser... LR <> LL
<Axioplase> a simple recdec parser can be seen as a simple "match" (well... multiple functions calling each other...)
<Axioplase> I have written one for OCaml last year...
bluestorm has quit ["Konversation terminated!"]
pango has quit [Remote closed the connection]
pango has joined #ocaml
malc_ has quit ["'orrible'orrible language"]
Submarine has joined #ocaml
dibblego has joined #ocaml
Cheery has quit ["Download Gaim: http://gaim.sourceforge.net/"]
postalchris has quit ["Leaving."]
smimou has quit ["bli"]