ChanServ changed the topic of #ocaml to: http://icfpcontest.cse.ogi.edu/ -- OCaml wins | http://www.ocaml.org/ | http://caml.inria.fr/oreilly-book/ | http://icfp2002.cs.brown.edu/ | SWIG now supports OCaml
<mrvn_> RichiH: Would would you do with a (m:int)? Use its value? It has none. Assign a value? You can't.
<mrvn_> s/Would/What/
<RichiH> mrvn_: well, i am only getting into funtional programming now
<RichiH> i have old behaviourisms i gotta dump, it seems :)
<mrvn_> yu allways haveto have some value to wich to assing a name like m. You can't have uninitialised variables or null pointers in ocaml.
<RichiH> k
<RichiH> let monte_carlo_pi (x, y) =
<RichiH> n = n + 1;
<RichiH> if ignore (inside (x, y)); true then m = m+1
<RichiH> pi = 4 * m * n ;;
<RichiH> why do i get "unbound value" for n, now?
<mrvn_> Where do you bind it?
<RichiH> what do i have to bind it to?
<mrvn_> And why do you compare n with n+1 and throw away the result?
<RichiH> uh, i want to add 1 to n
<RichiH> og damn, = is a bool and no calculus operation
* RichiH fetches brick
<RichiH> *hit self*
<mrvn_> You can't. You can only create a new n thats one more then the one before. And the n would only last as long as the let statement.
<mrvn_> Only way out of it is using a reference.
<RichiH> a reference being what?
* RichiH has a feeling mrvn_ is going to kill him before his semester ends
<mrvn_> let n = ref 0 let m = ref 0 let monte_carlo_pi x y = n <- n+1; if ignore (inside (x, y)) then m <- m+1; 4 * m * n
<mrvn_> let n = ref 0 let m = ref 0 let monte_carlo_pi x y = n <- !n+1; if ignore (inside (x, y)) then m <- !m+1; 4 * !m * !n
<mrvn_> A reference is basically a pointer. You can bind the thing it points to to a new value thereby changing the reference.
<RichiH> "Unbound instance variable n" both times
<mrvn_> <- assigns and ! drefefs.
<RichiH> ok
<mrvn_> let n = ref 0
<mrvn_> s/drefefs/derefs/
<mrvn_> Did you try the version without !?
* RichiH is seeing the blessed light of revelation :)
Yurik has quit ["÷ÙÛÅÌ ÉÚ XChat"]
<RichiH> i tried both versions, but i have to add ; and ;; into your code
<RichiH> mrvn_: let me grok everything and see if i can work it out from scratch after that
<RichiH> then i'll tell you if i succeeded
<mrvn_> Also ignore is a bad name since its already used in ocaml
<RichiH> i know
<RichiH> but i can get rid of teh warning this way
<RichiH> (i learned that from you:)
<mrvn_> What warning?
<RichiH> btw, wenn du in der nähe von münchen wohnst, hast du ein bier gut
<RichiH> # let test_1 (x, y) =
<RichiH> if inside (x, y); true then 1;;
<RichiH> Warning: this expression should have type unit.
<RichiH> This expression has type int but is here used with type unit <-- only for testing syntax, no real program yet
<mrvn_> # let inside x y = true;;
<mrvn_> val inside : 'a -> 'b -> bool = <fun>
<mrvn_> # let n = ref 0 let m = ref 0 let monte_carlo_pi x y = n := !n+1;if inside x y then m := !m+1; 4 * !m * !n;;
<mrvn_> val n : int ref = {contents = 0}
<mrvn_> val m : int ref = {contents = 0}
<mrvn_> val monte_carlo_pi : 'a -> 'b -> int = <fun>
<mrvn_> #
<mrvn_> Sorry, its := for refs. <- is for mutables in classes.
<RichiH> # let n = ref 0 let m = ref 0 let monte_carlo_pi x y = n := !n+1;if inside x y then m := !m+1; 4 * !m * !n;;
<RichiH> This function is applied to too many arguments
<mrvn_> Why do you use "(x,y)"?
<RichiH> because we learned to use tupels as being more "clean code"-ish. they want it, i do it
<mrvn_> It prevents currying.
<mrvn_> It means you have to allways give all parameter for a function.
<mrvn_> and its more to type
<RichiH> yep
<RichiH> well, i'll do it without tupels and if they mind, they are free to argue with me
<mrvn_> I guess (x,y) is a pair of coords so it would make sense their to pair them.
<RichiH> you are right and i am of the same opinion
<RichiH> yes, it is
<mrvn_> Or to use {x:int;y:int}
<RichiH> they are floats
<mrvn_> samme thing
<RichiH> it's calculation of pi via monte carlo
<mrvn_> one of the more stupid methods.
<RichiH> yep
<RichiH> but it's my homework
<mrvn_> Is it realy 4 *. !n *. !m? Isn't 4 *. !n /. !m ?
<taw> huh
<taw> 4 *. may not work !
<mrvn_> Its floats. Muts be +. *. 1.0
<taw> it's (Float->Float->Float) (Int)
<mrvn_> 4.
<taw> oh
<RichiH> the formula is 4 * m * n, where m is the number of "hits" (inside is true) and n is the number of tries
<RichiH> let inside x y = (x*x + y*x) < 1;;
<taw> rotfl
<taw> this formula kickz azz ;)
<RichiH> yeah
<taw> it must be m/n
<taw> otherwise it would be
<taw> it would not have limit
<RichiH> but as i only needed the syntax, i didn't care for what mrvn_'s code actually did, for starters :)
<RichiH> erm, yes
<RichiH> my bad
<taw> how is "to have limit" and "to not have limit" in english ?
<RichiH> i can tell you in german
<taw> and i can tell you in polish :)
<RichiH> "ist endlich" "ist unendlich"
<taw> but that's not the point
<mrvn_> # let monte_carlo_pi x y m n = let n = n +. 1. in let m = if inside x y then m +. 1. else m in (4. *. m /. n, m, n);;
<mrvn_> val monte_carlo_pi : 'a -> 'b -> float -> float -> float * float * float =
<mrvn_> <fun>
<mrvn_> #
<taw> they don't teach math jargon in english classes :)
<mrvn_> That would be a more functional way.
<mrvn_> limited, not limited/unlimited
<taw> hmmm
<mrvn_> convergent is the math term
<taw> oh
<taw> convergent divergent
<taw> this is what i was thinking about
<taw> "limited" sounds more like bounded ;)
<mrvn_> Join #ocaml, learn math speak
<RichiH> heh
<mrvn_> Its bound by 4 but converges on PI
<taw> people are going to lambda classes to show how manly they are ;)
<RichiH> actually, they offered a math course in english, but prefered non-native german speaking ppl so i couldn't get into it
<taw> hackers are weirdos ;)
<RichiH> speaking of hacking :)
<taw> mmm
<mrvn_> I like a more random approach to compute PI. Draw equidistant lines and drop a pin on it randomly. By counting the times it crosses a line or not you can compute PI.
<taw> is it that site where you are supposed to "break" into pages ?
<taw> to pass levels ?
<RichiH> mrvn_: m and n are ints. always
<RichiH> taw: yep
<mrvn_> RichiH: Then you have to convert them to float for the result and you are limited to 31 Bit number of tries.
<mrvn_> Better make them float all the way.
* taw wonders why nobody is dividing by monte carlo
<taw> computationaly division is harder than pi
<RichiH> how big can get numbers in ocaml, anyway?
<taw> RichiH: 31 default
<taw> use Int64 if you want more
<RichiH> k
<mrvn_> RichiH: 31 or 63 Bit deending on your cpu.
<RichiH> athlon xp
<RichiH> and suns at the university
<taw> aren't they 15 on windoze for compatibility with the rest of stuff ?
<RichiH> and a p1 133 in my laptop
<mrvn_> I had some problems showing code at university that run perfectly at home. I have 63 Bit, uni has only 31. :(
<RichiH> mrvn_: now that is great...
<RichiH> how could i test that?
<mrvn_> RichiH: Uni has cheap PCs. I have an Alpha.
<RichiH> just do (x:int64);; ?
<RichiH> wow
<RichiH> alphas are nice
<mrvn_> Its Int64 and you can't calculate them as with ints.
<taw> mmm
<taw> people have alphas at home ?
<taw> that's unfair ;)
<mrvn_> let n = Int64.from_int 0 in Int64.add n 1;;
<mrvn_> hmm, its not from_int
<RichiH> # let n = Int64.from_int 0 in Int64.add n 1;;
<RichiH> Unbound value Int64.from_int
<taw> Int64.zero
<taw> you are supposed to use .zero and .one
* RichiH has a syntax error coming
<RichiH> # let n = ref 0;
<RichiH> let m = ref 0;
<RichiH> let pi = ref 0.0;
<RichiH> let monte_carlo_pi (x, y) =
<RichiH> n <- n + 1;
<RichiH> if ignore (inside (x, y)); true then m <- m + 1
<RichiH> pi <- 4 * m * n ;;
<RichiH> Syntax error
<taw> damn
<RichiH> the "<-" after pi
<taw> this is so unfunctional
* RichiH tries to hide behind his brick
<RichiH> taw: fell free to chew me out. i can only learn from it
<mrvn_> RichiH: pi := 4. *. (float_of_int m) /. (float_of_int n);;
<RichiH> i need to break the old habits asap
<mrvn_> "if ignore (inside (x, y)); true" also amkes no sense
<RichiH> what would you use instead?
<mrvn_> if inside (x,y) then
<RichiH> heh
<mrvn_> Your code looks if x,y is inside, throws that away and uses true for the if.
<RichiH> oups!
<RichiH> mrvn_: getting to the floats: you would propose using floats because they can have more than 31 bit, right?
<RichiH> or are there any other reasons i should know about?
<mrvn_> RichiH: and since you need float for a division.
<mrvn_> Otherwise PI equals 3
<RichiH> ...
<mrvn_> You multiply by 4 and its signed so its only 28 Bits for n.
<mrvn_> Thats 500 million points or 22360*22360 points.
<mrvn_> Thats probably good for 3 or 4 digits.
<RichiH> 500 million random numbers seems a lot to me
<mrvn_> If at all
* RichiH yearns for his database languages ;)
<mrvn_> Thats about 10 seconds to a minute on your pc.
<RichiH> *blink*
<mrvn_> or less if the optimiser is good.
<RichiH> k
<RichiH> let monte_carlo_pi (x, y) =
<RichiH> n <- n + 1;
<RichiH> if inside (x, y) then m <- m + 1
<RichiH> pi := 4. *. (float_of_int m) /. (float_of_int n);;
<RichiH> Syntax error
<mrvn_> n:=n+1
<RichiH> at ";;"
<mrvn_> and ; after m:=m+1
<RichiH> ahhh
<RichiH> # let monte_carlo_pi (x, y) =
<RichiH> n := n + 1;
<RichiH> if inside (x, y) then m := m + 1;
<RichiH> pi := 4. *. (float_of_int m) /. (float_of_int n);;
<RichiH> This expression has type int ref but is here used with type int
<mrvn_> !m and !n
<taw> f*ck
<taw> have you ever trued ledit ?
<taw> if not yet, then do not ever do it
<taw> let countpi rounds =
<taw> let rec countpi_aux n m = function
<taw> 0 -> 4.0 *. (float_of_int n) /. (float_of_int m)
<taw> | r -> let x = Random.float 1.0 and y = Random.float 1.0 in
<taw> if (x*.x +.y*.y) < 1.0 then countpi_aux (n+1) (m+1) (r-1)
<taw> else countpi_aux n (m+1) (r-1)
<taw> in countpi_aux 0 0 rounds
<taw> ;;
<taw> this is nice functional code
<RichiH> # let monte_carlo_pi (x, y) =
<RichiH> n := !n + 1;
<RichiH> if inside (x, y) then m := !m + 1;
<RichiH> pi := 4. *. (float_of_int m) /. (float_of_int n);;
<RichiH> This expression has type 'a * 'b but is here used with type int
<taw> look at my code ;)
<taw> it is nicer
<RichiH> i am
<taw> and functional
<taw> with tail recursion, no refs
<RichiH> i am trying to grok it, atm :)
<taw> you use it:
<taw> countpi 100000;;
<taw> let countpi rounds =
<taw> let rec countpi_aux n m = function
<taw> 0 -> 4.0 *. (float_of_int n) /. (float_of_int m)
<taw> | r -> let x = Random.float 1.0 and y = Random.float 1.0 in
<taw> countpi_aux (if (x*.x +.y*.y) < 1.0 then n+1 else n) (m+1) (r-1)
<taw> in countpi_aux 0 0 rounds
<taw> ;;
<taw> it looks even nicer, but many people can't stand valued if ;)
<RichiH> hmm, countpi 100000000000000000;; wasn't a good idea, probably
* taw thinks so too ;)
<taw> if you want fast results there are algorithms which are milion times faster
<taw> in fact with completely different complexity
<mrvn_> RichiH: shoudln't compile
* RichiH doesn't care about fast results
<RichiH> all i want to do is get the right way of thinking into my brain
<mrvn_> taw: Do you know a digit dropping algorithm?
<RichiH> mrvn_: i ctrl-c'ed it
<RichiH> # countpi 1000000;;
<RichiH> - : float = 3.13922
<taw> mrvn_: i know it exists but i don't remember exact formula
<RichiH> "3.13922"....
<mrvn_> one digit.
<taw> huh ?
<taw> two !
<taw> 0.0 to 4.0
<mrvn_> 100 times that and you might get another
<taw> # countpi 1000000;;
<taw> - : float = 3.140732
<RichiH> taw: that's why it's called monte carlo :)
<mrvn_> 3.1 is one digit after the .
<mrvn_> Also the random isn't very good.
<taw> mrvn_: but what we are counting is whole 3.... not only after-digit
<taw> # countpi 10000000;;
<taw> - : float = 3.1413564
<taw> 4 digits
<taw> RichiH: anyway, learn always to use tail recursion, and never refs
<mrvn_> Try going from y=1 downto y=0, calculate the x*y=1 and add x * dy to m and dy to n.
<taw> mrvn_: i counted pi that way !
<mrvn_> in increments of dy
<taw> i was a child then and used pascal ;)
<taw> i was damn proud that i found out that formula by myself hehe
<mrvn_> As far as counting goes thats a very good method.
<taw> how old i was ... 14 ?
<taw> :)
* RichiH found out about 1+2+...(n-1)+n = (1+n)*n/2 (for n mod 2 = 0, else (1+n-1)*n/2+n) out in grundschule :)
<mrvn_> I like the geometric way: Start with a six sided polygon of radius 1. Each side has length one. Half the side and draw a line from the center of length one through that. Connect the spikes and you have a 12 sided polygon.
<RichiH> mrvn_: that would be my approach, too
<mrvn_> Its quite fast but you need to compute roots.
<taw> syntax error: "fast" and "to compute roots" in one sentence
<mrvn_> You can also calculate the arcus tangens of a small angle. We know that tan Pi/4 = 1 and theres a formula relating tan a and tan 2a.
<taw> calculate "arctan" isn't really fast way either
<mrvn_> Also theres a series which sum gives the arcus tangens of x which converges realy fast for small x.
<RichiH> or you could just go to this 3.141[...].jp site :)
<mrvn_> taw: The series contains x, x^2, x^3, x^4, x^5. If x <0.1 you gain a digit accuracy with each elemnt of the series.
<taw> RichiH: you need it why ?
<RichiH> taw: university
<taw> oh
<taw> we have ocaml course here too
<RichiH> ocaml is quite neat
<RichiH> only i don't really understand it, yet
<taw> first few weeks consist of brainwa^H^H^H^H^H^H^Hshowing us paradigm of functional programming
<RichiH> ^H?
<taw> ^H is traditional espace code of backspace ;)
<RichiH> oic
<taw> we have to write ton of stuff using the only true functional way
<taw> later, we will go back to real life ;)
<RichiH> heh
<RichiH> ok, i can see why your approach is better than mine (i think), but i still need to finish this according to specs
* RichiH grumbles
<RichiH> the copy and paste actually substituted characters!
<taw> let root3 a =
<taw> let rec root3_aux a x e =
<taw> (
<taw> if (abs_float ((x*.x*.x) -. a) <= e *. abs_float (a)) then
<taw> x
<taw> else
<taw> root3_aux a (x +. (((a /. (x *. x)) -. x)/.3.0)) e
<taw> )
<taw> in root3_aux a (if a >= 1.0 then (a /. 3.0) else a) (1e-15)
<taw> ;;
<taw> one of tons of tasks we had to do the only true way
<RichiH> that looks... nice... ;)
<taw> this one is searching for third root of number
<RichiH> yep
<RichiH> # let foo x = x**2;;
<RichiH> This expression has type int but is here used with type float
<RichiH> why is that, btw?
<RichiH> i always got to use x*x instead
<taw> use x *. x
<taw> always
<taw> .* is one multiplication
<taw> ** uses very complex algorithm ;)
<taw> hmmm, this algorithm is real not complex
<taw> but anyway :)
<RichiH> ok, the last one for today (i hope):
graydon has quit ["xchat exiting.."]
<RichiH> # let pi_calc repeats =
<RichiH> monte_carlo_pi (Random.float 1.0, Random.float 1.0)
<RichiH> in repeats;;
<RichiH> Unbound value repeats
<taw> huh ?
<taw> what was that supposed to mean ?
<RichiH> i know it's not functional, but as far as i can see, we are supposed to do it that way
<taw> but that will not work
<taw> :)
<RichiH> i want to let it calcualte that repeats times
<RichiH> i know it doesn't work. i want to know how it wil work .)
<taw> let pi_calc repeats = for i = 1 to repeats do monte_carlo_pi (Random.float 1.0, Random.float 1.0) done;;
<taw> if any
<taw> of course it's bad bad bad
<RichiH> # pi_calc 100;;
<RichiH> - : unit = ()
<taw> good
<RichiH> why?
<RichiH> sholdn't it give me some value?
<taw> you have result in var pi
<RichiH> oh
<RichiH> how do i print it?
<taw> let pi_calc repeats = if repteas = 0 then () else monte_carlo_pi (Random.float 1.0, Random.float 1.0); pi_calc (repeats-1);;
<taw> this one looks saner
<taw> let pi_calc repeats = if repeats = 0 then () else monte_carlo_pi (Random.float 1.0, Random.float 1.0); pi_calc (repeats-1);;
<taw> in interactive mode:
<taw> !pi;;
<taw> in real life:
<taw> print_float !pi;; print_newline();;
<RichiH> k
<RichiH> it finally works
<taw> other than the fact that you should make in Float->Float->Unit not (Float*Float)->Unit
<taw> then let's call it "works"
<RichiH> the # countpi 100000000000000000;; still runs...
<taw> i mean:
<taw> let monte_carlo_pi x y =
<taw> not
<RichiH> for half an hour now
<taw> let monte_carlo_pi (x,y) =
<taw> and
<RichiH> taw: it's because i use coordinates
<taw> monte_carlo_pi (Random.float 1.0) (Random.float 1.0)
<taw> not
<taw> monte_carlo_pi (Random.float 1.0, Random.float 1.0)
<RichiH> i know what you mean, but every x _needs_ an y
<RichiH> thus the tupel
<taw> RichiH: just because it looks like coordinate doesn't mean it should be used
<taw> tuple is expensive to make
engstad has joined #ocaml
<taw> it is made in some evil place in memory
<taw> then pointer passed
<taw> instead of 2 simple pushes
<RichiH> for this function, they are always tupel and we are required to write it with tupels
<taw> you are required to write it with tuples, refs etc ?
<taw> this does not follow the one true way
<RichiH> not with refs, but with tupels
<RichiH> i included your solution and will ask them why i should use their way
<RichiH> i'll tell them you two own them at ocaml
<taw> hehe
* taw lovez to ownz people
<RichiH> heh
<RichiH> who doesn't?
<whee> heh
<whee> I hardly ever use tuples
<RichiH> well, i need more than 3 hours sleep once a week, so i will go off now
<taw> tuples are useful mainly for polimorphic constructors
* RichiH will add #ocaml to his standard channels
<taw> using them for function is preverted :)
<taw> oh, and for multivariable matches
<whee> well yeah
<taw> darn, just seen some really huge spider here
<taw> for a moment i thought it was a mouse :)
<RichiH> heh
<taw> is it related to chernobyl somehow ?
<RichiH> attack of the polish killer spiders from outta space
<whee> oh and now that someon's awake, have you used steams for parsing any taw?
<whee> streams*
<taw> parsing ?
<taw> you mean ocamlyacc ?
<taw> i only use lex/yacc for parsing
<whee> oh
<whee> there's a Stream module, it's a camlp4 language extension
<taw> now where did this m*f* go
<whee> it looks like I should be using it for my problem but I don't really know how :\
<taw> why can't you use yacc ?
<whee> yacc is overkill
* RichiH waves
<whee> what I have is a string in the form of standard command line arguments, like "-y -m 300 -d "some string"", and I need to parse that into an array of each word
* RichiH also hugs mrvn_ and taw
<whee> simply splitting by whitespace doesn't handle quoted strings, so I can't do that
<whee> a character based stream seems like the best way to do this because it's not that complicated
<taw> whee: maybe use just lex ?
<taw> if you can write non-recursive def lex is enough
<whee> seems like overkill though, and I'd like to learn streams
<taw> no it's not
<whee> I just can't find good examples :\
<taw> it may seem like one, but it's not
<whee> is it easy to do this in lex?
<RichiH> cu
<taw> very easy
RichiH has quit ["mv /dev/richih /usr/home/bed"]
<taw> rule token = parse
<taw> [^ "']+ {WORD (Lexing.lexeme lexbuf)}
<taw> | "[^"]+" {WORD (Lexing.lexeme lexbuf)}
<taw> hmm
<taw> syntax of rx is somewhat different
<taw> but you get the idea
<whee> so it's just a bunch of regular expressions that handle state
<taw> yes
<taw> state ?
<taw> what state :)
<taw> you don't need any
<taw> you can write rx for "argument"
<taw> and another for "whitespace"
<taw> and that's all
<whee> by state I mean what it's parsing at the moment, the meaning of it
<taw> more or less
<taw> fuck, here it is
<taw> the 3vil spider
<whee> heh
<taw> and i don't have anything to kill it
<whee> I usually torture insects that get in my room :|
<taw> it's damn too big
<whee> put it in a jar and put that in the freezer
<whee> :D
<taw> killed
<taw> the world is safe again
* taw has to go to bed now
<taw> i hope no more evil spiders will come
taw has left #ocaml []
engstad has left #ocaml []
Yurik has joined #ocaml
Yurik has quit [Read error: 60 (Operation timed out)]
Yurik has joined #ocaml
<Yurik> re
Yurik has quit [Read error: 54 (Connection reset by peer)]
gl has joined #ocaml
mattam has joined #ocaml
zack has joined #ocaml
zack is now known as zack_afk
merriam has quit [benford.freenode.net irc.freenode.net]
merriam has joined #ocaml
zack_afk has left #ocaml []
karryall has joined #ocaml
mrvn has joined #ocaml
gl has quit [Read error: 104 (Connection reset by peer)]
gl has joined #ocaml
mrvn_ has quit [Read error: 110 (Connection timed out)]
taw has joined #ocaml
zack has joined #ocaml
taw has quit ["Client Exiting"]
ayrnieu has joined #ocaml
karryall has quit ["bye .."]
ayrnieu is now known as ^ayrcier
^ayrcier is now known as ayrnieu
karryall has joined #ocaml
skylan has quit [Read error: 104 (Connection reset by peer)]
skylan has joined #ocaml
graydon has joined #ocaml
graydon has quit [Remote closed the connection]
zack has quit [Read error: 104 (Connection reset by peer)]
skylan has quit ["blah"]
TimFreeman has joined #ocaml
<TimFreeman> On my Debian system, Flash movies have the sound going several times faster than it is supposed to. Anyone have a quick fix? I'm playing them under Mozilla.
<TimFreeman> Oops, should have said that to #debian.
TimFreeman has left #ocaml []
lka has joined #ocaml
<lka> Hello Could anybody help me a bit on how to compile OCaml to native code on Windows?
<ayrnieu> lka - yes.
<lka> I have Visual Studio so I think it's linker is fine but what about the assembler?
<ayrnieu> its, and I don't understand your question.
<lka> Ok, I understand I need to have MS Assembler in order to compile to native code
<lka> Assembler is not included in Visual Studio
<ayrnieu> Sorry, I assumed that you wanted help with compiling with OCaml's native-code compiler, since compiling ocaml to other-than native code seems to be the only way to compile it.
<ayrnieu> lka - I don't know what Visual Studio is. You might want to get cygwin instead.
<lka> Hmmmm, seams we are crossing lines ... let me try to put it simpler
<lka> Working on Windows 2000, how am I to compile OCaml source to produce an exe?
<ayrnieu> You use OCaml, of course.
<lka> OCaml produce byte-code, doesn't it?
<ayrnieu> Yes, it does. It also produces native-code.
<lka> Byte-code to exe needs assembler and linker
<ayrnieu> lka - your last statement is wrong on many levels.
TachYon25 has joined #ocaml
<ayrnieu> lka - ignoring it, I'll say that if you have the OCaml native-code-compiler, then all you have to do is understand its usagew.
<lka> is it ocamlopt?
<ayrnieu> lka - I, for instance, have both byte-code compiler and a native-code compiler versions of OCaml; I don't know if the native-code compiler has been ported to Win32.
<ayrnieu> lka - yes, I think so.
<gl> it is
<lka> no need for the Miscrosoft Assembler and Linker?
<gl> no need
<lka> Ok, fine Thanks ayrnieu and gl
<ayrnieu> Welcome.
<lka> Sorry guys but just found something that proves your are a bit mistaken
<ayrnieu> lka - observe the columns: Native MS Native MinGW Cygwin
<ayrnieu> (You're probably looking at the requirements for compiling with Microsoft Visual C.)
<ayrnieu> "for the version compiled"
<karryall> no I think he's right
<lka> I'm looking at the Native MS column, it says MSVC+MASM are required for natice-code generation
<karryall> ocamlopt spits assemble code anyway,
<karryall> so its needs an assembler program
<karryall> that's MASM
<lka> Thanks again guys, I'm okay now
<ayrnieu> karryall - MinGW and Cygwin don't have assemblers?
<ayrnieu> lka - "Native MS" does not mean "Only option for Microsoft Operating Systems" -- but if you're OK, fine.
<karryall> he (lka) said he was using Visual Studio
<ayrnieu> oh, indeed.
graydon has joined #ocaml
lka has quit []
TachYon25 has quit ["bez ki³y nie ma zaliczenia (z prawd studentek AM)"]
Torquemada has joined #ocaml
karryall has quit ["bye .."]
taw has joined #ocaml
bouallag has joined #ocaml
Begbie has quit [Remote closed the connection]
Begbie has joined #ocaml
<bouallag> ls
<taw> hello
bouallag has quit ["Client Exiting"]
MegaWatS has joined #ocaml
mattam has quit ["reboot"]
Dalroth has joined #ocaml
mattam has joined #ocaml
mattam has quit [Client Quit]
Torquemada has quit [Read error: 110 (Connection timed out)]
karryall has joined #ocaml
mattam has joined #ocaml
gl has quit [Read error: 104 (Connection reset by peer)]
gl has joined #ocaml
Torquemada has joined #ocaml
ayrnieu has quit ["ERC v2.93 $Revision: 1.308 $ (IRC client for Emacs)"]
<whee> finally, camlp4 is back in the makefiles
<whee> I can go back to using cvs now heh
<taw> oh
<taw> war over ?
<whee> doubt it
skylan has joined #ocaml
zack has joined #ocaml
mattam has quit ["leaving"]
gl has quit [Read error: 54 (Connection reset by peer)]
Torquemada has quit ["Lost terminal"]
gl has joined #ocaml
zack is now known as zack_work
taw has quit ["Client Exiting"]
Dalroth has quit [Remote closed the connection]
<whee> heh I couldnt figure out how to use ocamllex/ocamlyacc if my life depended on it
<whee> this oreilly book seems to be good but I'd be better off with the finished source to this basic parser than whatever they have now ;\
<whee> I can'tseem to put all the pieces together correctly
<gl> define your types in a file (ast.mli for example), then you must define a function witch associate a token to a regexp (lexer.mll), and a function witch will create you abstract syntax tree (parser.mly)
<whee> I don't get the first part
<whee> I thought I define types of all important things in the mly
<gl> it's not clean
<mrvn> The lexer needs types from the parser and the parser from the lexer if you don#t put your types into another file.
<whee> right but I don't get what defining types will get me
<whee> I mean I don't know what I mean
<whee> ehh
<mrvn> If you don#t needs your own types then don#t.
<whee> the only example I have that I understand is the calculator one in the ocaml manual, which is too simple
<whee> the one in the oreilly book seems like spaghetti
<gl> whee: i can paste you a part of some files, if you want
<gl> (in private)
<whee> go for it
zack_work is now known as zack
zack has left #ocaml []
graydon has quit []
* gl is away: I'm busy