Yurik 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| Early releases of OCamlBDB and OCamlGettext are available
<whee> (a, b)
j_bravo_ has quit [Read error: 104 (Connection reset by peer)]
<asqui> (a+1, b) or (a + 1, b) ?
<whee> usually it's safer to seperate operators from operands
docelic has quit ["Client Exiting"]
<asqui> ok
<whee> also you can get away with using == instead of = with your comparisons in the routes function
<whee> I really don't know if it makes a difference when it's compiled, but physical equality is safe for ints
<whee> and you may want to use pattern matching in routes as well
<whee> not that it'll make it shorter or anything, just an alternative
<whee> heh
<asqui> Whats the difference between = and == in Caml?
<whee> = is structural equality while == is physical
<asqui> structural?
<whee> # [[1, 2, 3] = [1, 2, 3], [1, 2, 3] == [1, 2, 3]];;
<whee> - : (bool * bool) list = [(true, false)]
<whee> you can think of physical equality as a pointer comparison
<whee> minus the pointers of course :D
<whee> structural equality will go and do some recursive comparisons on structures like lists and the like
<asqui> Right...
<whee> is routes tail recursive?
<whee> I can't remember if that qualifies as being it or not :|
<asqui> Yes.
<asqui> Wait...
<asqui> I dunno...
<whee> yeah it is, nevermind
<asqui> Theres an idea... head recursive implementations of the functions!
<whee> in your limitations section of route I don't think the depth of recursion is really an issue with the way tail recursion is
<whee> it won't be any slower than explicit iteration after the compiler gets to it
<MegaWatS> tail recursion WILL still be slower than simple iteration in many cases ... for example, I don`t think the compiler unboxes (floats and the like) over tail recursive calls
<whee> not as bad as a non-tail recursive function versus iterative though
<whee> hope not anyway :P
<lament> MegaWatS: that's a problem with the compiler.
<lament> tail recursion _should_ be as fast as iteration :)
<asqui> Wait, i dont follow what you are saying here: "in your limitations section of route I don't think the depth of recursion is really an issue with the way tail recursion is"
<whee> I thought you were getting at stack size and all with that but maybe not
<asqui> lol
<lament> Is there a good Haskell/Scheme/ML comparison anywhere?
<asqui> No, I was just saying that by the time you get to overflowing the integer type youll be waiting for days.
<whee> this looks pretty good though
<whee> I can't find anything major
<whee> I can think of your n-dimensional solution as well :D
<whee> nice short solution to that one
<asqui> Is tail recursion preferred to head recursion?
<whee> I would assume yes
<asqui> So it would be a good idea to include tail recursive implementations of all my functions?
<whee> the functions in this look good
<whee> D:
<lament> What is head recursion?
<asqui> Doesnt head recursion unnecessarily inflate the stack though, by having all these intances of the fucntion waiting for their result?
<whee> head recursion leads to stack problems yes
<lament> If by head recursion you mean anything other than tail recursion then yes, it deos
<whee> heh
<lament> *does
<Yurik> cu later all
<asqui> What is the generalised definition of head and tail recursion?
Yurik has quit ["÷ÙÛÅÌ ÉÚ XChat"]
<asqui> The only way I know it is: Head recursion = normal recursion, Tail recursion = pass around an accumilator so you dont have to make them wait for the recursive call to return
<lament> asqui: no
<lament> asqui: A function is tail recursive if the very last thing it does is make its recursive call.
<asqui> lament: Shit... :)
<lament> and head recursion is anything else
<whee> heh
<lament> accumulator or no accumulator, it doesn't matter
<asqui> So..err...
<asqui> let rec factorial x = if x < 0 then 0 else if x = 0 then 1 else x * (factorial (x - 1));;
<asqui> Head or tail?
<lament> head.
<lament> because the last thing the function does is return x * (factorial (x - 1))
<asqui> Is that becasue the last...
<asqui> yeah so the last thing it does is multiply the result by x...
<lament> exactly.
<asqui> whereas in: let rec fact1 (a, x) = if x < 0 then 0 else x = 0 then a else fact1(a * x, x - 1);;
<asqui> The last thing really *is* the recursive call.
<lament> tail-recursive.
<lament> yes.
<asqui> Right
<asqui> so geenrally tail is better than head?
<lament> if the compiler is smart enough.
<lament> which it probably is, in ocaml, but i don't know
<asqui> So if the compiler is dumb itll wait for them to return anyway, whereas if its smart itll turn it into a loop?
<lament> yes.
<asqui> Right.
<asqui> whee: What was this short solution to the n-dimensional problem you spoke of?
<asqui> I was planning on firstly doing an insane nested tuple implementation of distanceNd
<asqui> because we havent been taught lists yet
<asqui> then some reading up on lists and a proper implementation
<asqui> but for routesNd I cant think of anything neat.
<asqui> Its just turning into a mess of recursion implemented for-loops in my head :)
<whee> oh
<whee> I was thinking of using lists and a nice map/fold
<asqui> map/fold???
<whee> map and fold_left
<whee> rev_map would be better here actually
jao has quit [Remote closed the connection]
<asqui> heh this is a little too hardcore for the caliber of this course :)
<whee> nah :P
<whee> I don't think it's possible to do an arbitrary number of dimensions without using lists or some other data structure as an argument
<asqui> This is Caml Light im working with btw, does this stuff apply to Caml Light?
<gl> caml light :/
<whee> it should
<asqui> I was thinking of a death-nested tuple
<whee> depth you mean? :D
<asqui> point A(a_1, a_2, a_3) becomes (a_1,(a_2,(a_3,(0,0))))
<asqui> That was the only thing I could think of using the things we have been taught so far. I am told lists will be covered next week!
<whee> it'd be tons easier to do it with lists
<asqui> Yeah. I was only planning to do this tuple thing for distanceNd becasue its just a matter of popping them off one at a time and adding them together
<asqui> Though routesNd with the nested tuple thing would be death.
MegaWatS has quit ["Actually, people sometimes talk about man's "bestial" cruelty, but that is being terribly unjust and offensive to the beasts:]
<asqui> how do i linebreak inside the displaymath environment?
<asqui> in LaTeX...
<whee> \\?
<whee> I don't know, I've been using ConTeXt now :|
<asqui> is the question mark part of it?
<whee> no
<asqui> I tried \\ and it didnt do anything :)
<asqui> :( even
<asqui> heh
<whee> it should do something heh
<asqui> doesnt appear to :(
<asqui> let rec distanceNd = fun
<asqui> (0, 0) (0, 0) -> 0 |
<asqui> (a, A) (b, B) -> abs(a - b) + distanceNd A B;;
<asqui> This expression has type int * int -> int * int -> int,
<asqui> but is used with type int -> int -> int.
<asqui> I am not followink
<whee> your recursive call to distanceNd is using two integers
<whee> while the definition of the function requires integer tuples
<asqui> how do you now A and B are integers?
<whee> the first match case matches integers, so A and B have to be integers
<asqui> if I try to match (0,0) (0,0) it assumes that the second part of the tupes will ALWAYS be an integer?
<whee> well you're matching the arguments against (0, 0) so that would be a tuple of integers that the function needs
<whee> since only integers can be compared against 0
<asqui> shit... so how do I make it return (sumof |a_n - b_n|) given (a_1, (a_2, (a_3, (0,0)))) and (b_1, (b_2, (b_3, (0,0)))) ?
<whee> I don't think you can now thta I think about it
<whee> I don't know
<whee> heh
<whee> with using tuples like that it's not an easy thing to type since it's a tuple of an int and another tuple
<whee> except it has to end somewhere
<whee> you end up reinventing lists :D
<asqui> yeah.
<asqui> time to read up on lists.
<asqui> What about the empty tuple?
<asqui> Is there such a thing?
<whee> no
<whee> you could have a tuple of unit, that'd be emptyish
<asqui> What is unit?
<whee> you can think of it as void
<whee> it's just nothing, represented using ()
<asqui> Why is it called unit?
<whee> dunno heh
<asqui> let rec distanceNd = fun
<asqui> (a, (unit)) (b, (_)) -> abs(a - b) |
<asqui> (a, A) (b, B) -> abs(a - b) + distanceNd A B;;
<asqui> This expression has type int * 'a -> int * 'b -> int,
<asqui> but is used with type 'a -> 'b -> int.
<whee> use () , not the literal 'unit'
<whee> () is of type unit is what I meant
<asqui> This expression has type int * unit -> int * unit -> int,
<asqui> but is used with type unit -> unit -> int.
<asqui> lol
<asqui> time to stop persuing this and use lists
<whee> heh
<whee> well
<whee> you could do it if you assume you will never use the last value of the last tuple
<asqui> What do ou mean?
<whee> but that would be an ugly hack now that I thikn about it
<whee> and I don't think it would work anyway :|
<whee> actually it would work, but then you'd have to use Some/None which you probably havent covered yet either
<whee> and it ends up being some huge hack which would be better suited for lists :D
<asqui> roger-dee
<asqui> Okay so given two lists [a_1; a_2; ...; a_n] [b_1; b_2; ...; b_n] how can I find the sum of abs(a_n - b_n) ?
<whee> with map and fold
<whee> hold on, I'll get something
<whee> need to play with this, little rusty :D
<whee> # [a;b];
<whee> - : list (list int) = [[1; 2; 3]; [4; 5; 6]]
<whee> # List.fold_left (\+) 0 (List.map2 (fun x y -> abs (x - y)) a b);
<whee> - : int = 9
<whee> that's not caml light, thought
<whee> -t
<whee> I don't know if caml light has a map2 equiv, it does have fold
<whee> might be a shorter way to do that as well :|
<asqui> What is map2?
<whee> List.map2 f [a1; ...; an] [b1; ...; bn] is [f a1 b1; ...; f an bn]. Raise Invalid_argument if the two lists have different lengths. (ripped from ocaml docs)
<whee> using rev_map2 is probably better in this situation as it's tail recursive as well
<whee> and caml light has it. yay
<asqui> map;;
<asqui> - : ('_a -> '_b) list -> ('_a list -> '_b list) list = <fun>
<asqui> #map2;;
<asqui> - : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list = <fun>
<whee> fold is it_list in caml light
<whee> I'm trying to think of a way to do it with just fold_left2
<asqui> lol yeah i just read that in this tutorial and i thought "it_list... sound a bit like fold" heh
<whee> oh I'm an idiot
<whee> # List.fold_left2 (fun n x y -> n + abs (x - y)) 0 a b;
<whee> - : int = 9
<asqui> so... fold_left2 will take 2 parameters and work rigth to left?
<whee> that works as well, it's it_list2 in caml light
<whee> the function argument to fold_left2 will end up taking three parameters
mattam_ has quit ["zzzZZZZzzzz"]
<whee> first one is usually something that'll be added onto and the other two are the elements from the two lists
<whee> the 0 in the line I gave above is just the initial value of the whole thing
<asqui> right
<asqui> BO.
<asqui> it_list2 (fun a x y -> a + abs(x - y)) 0 [0;0;0;0;0] [1;2;3;4;5];;
<asqui> - : int = 15
<asqui> What docs did you use to find it_list2 ?
<asqui> Google returns exactyl 2 results for "caml light it_list2" and neither is in english!
<whee> under the core library link
<asqui> jep
<asqui> so this fold_left of yours is list_it ?
<whee> it's either list_it or it_list, heh
<asqui> heheh
<asqui> list_it starts fm the last elementin the list
<asqui> it_list from the first
<whee> fold_left is tail recursive, fold_right isnt
<asqui> but what difference does it make in this case whichw ay you go through the list?
<whee> none since addition is communitive
<asqui> bastard.
<whee> the tail recursive one would just be faster
<asqui> took the words out of my mouth
<whee> okay it_list is tail recursive
<whee> so that is your fold_left
<asqui> right
<asqui> it_list is called an iterator, right?
<whee> no
<asqui> Why not?
<whee> there's an iter function that does things iteratively like an iterator would (as if it were a for loop-type thing)
<whee> and map for creating a new list based on the result of some function on the elements of a list
<whee> I think they named them list_it and it_list for the resons you stated above
<asqui> This tutorial says "the following function is a list iterator. it takes a function f....balh balh" and its referring to it_list
<whee> I don't know if I'd call it an iterator
<asqui> The reasons I stated above? I stated reasons?
<whee> I think of an iterator as something that goes and applys some function to each element in some structure, doing it for the reason of some side-effect
<asqui> okay
<whee> well it_list starts with the first element of the list ("it"), and then does the rest ("list")
<whee> while list_it does the other way around
<asqui> so "it" refers to an element?
<asqui> I thought it was short of "iterate" ? :)
<whee> no clue
<asqui> it[erate from the beginning of the]_list
<asqui> :p
<whee> I think of it as a value since a few interpreters of other languages use the it variable to store the result of the last computation (if done interactively)
<asqui> Is this correct: The it_list function takes a function which transforms some
<asqui> accumulator given a member of a list, and applies this function to
<asqui> the elements of a list in turn, passing down the accumulator as it
<asqui> goes.
<whee> that's a mouthful :D
<asqui> whats another word for "mirror image"
<whee> trying to find a good description of it
<whee> I don't know how to word it either
<asqui> as in it_list is to list_it
<whee> reverse/opposite?
<asqui> Yeah that works...
<whee> jkads I found a java applet with pretty graphics http://www.cs.ukc.ac.uk/people/staff/cr3/toolbox/haskell/GHood/fold.html
<whee> :)
graydon has quit [Remote closed the connection]
<asqui> Hehe nice
<whee> I'm starting to get into haskell lately heh
lament has quit [Remote closed the connection]
<asqui> let distance A B = it_list2 (fun a A B -> a + abs(A - B)) A B;;
<asqui> Warning: the variable B starts with an upper case letter in this pattern.
<asqui> Meaning..... ?
<whee> usually uppercase is used to denote type constructors
<asqui> right
<whee> so it might not like that there
<whee> typically people use ', like the variables a and a'
<asqui> i dont follow
<whee> but it might be easier to pick different letters in that example
<asqui> ill jst use a b for the lists and acc for the accumulator
<whee> well if you had two points you could go and call one (x, y) and the other (x', y') so the naming isn't that odd
<asqui> I see.
<asqui> I was using x1 y1 x2 y2 at first, now xy uv and x y z u v w
<asqui> Right.. now the routesNd implementation...
<asqui> or maybe bed....
<asqui> night night, thanks for all your help and isee you tomorrow :)
j_bravo has quit ["Trillian (http://www.ceruleanstudios.com)"]
<asqui> Hang ona sec.
<asqui> If routes branches out and calls itself twice in the body then surely there is no way to have a tail recursive implementation of that by definition?
<whee> it's still tail recursive there I think
<asqui> it cant be, the last thing thats done is not the recursive call
<whee> I think it is
<whee> the fibonacci function has the same type of recursion, and it's tail recursive
<asqui> hummmmmm
<whee> or maybe it isnt
<asqui> wouldnt it be better to use lists?
<whee> okay it isnt
<whee> heh
<asqui> <-- has seen the light.
graydon has joined #ocaml
<asqui> tail recursion not only implies that te last thing must be the recrursive call, i think it also implies that the ONLY recursive call must be the last thing.
<whee> yes
<whee> you could do the addition in the style of folding
<asqui> and becasue tail recursion is magical because it can convert directly to a loop it is clear to see that if you make two recursive calls in the body there si no way to convert that to a loop.
<asqui> (Right?)
<whee> there is a way to do it
<asqui> folding? You mean like using an accumulator which you pass down?
<whee> http://triton.towson.edu/~akayabas/COSC455_Spring2000/Recursion_Iteration.htm look at this for an example of how the fibonnaci goes tail recursive
<whee> yours is essentially the same, except it's obviously a different function and you're not using multiplication
<asqui> I dont think there is. Straight recursion = loop, tree resursion = an arbitrary number of nested loops
<asqui> No but my routes function sums the values of two recursive calls, thus there is always a "pending function" as they call it, namely the addition.
<whee> right, but so does fib
<asqui> And because there is *two* recursive calls i dont see any simple way to implement tail recursion
<asqui> negative.
<asqui> the tail-recursive fib has last line: return fact_aux(n - 1, n * result)
<whee> right, the tail-recursive version does
<whee> but the original version doesn't
<whee> and it sums two recursive calls
<asqui> the head-recursive fib has last line: return n * fact(n - 1);
<asqui> yeah
<whee> so there should be a way to transform it
<asqui> oh...
<asqui> im looking at factorial, duh
<asqui> hmmmm
<asqui> i can se ho they do it here, becasue youre falling fib(n-1) and fib(n-2)
<asqui> But in my case im doing foo x-1 y z + foo x y-1 z + foo x y z-1
<asqui> They have nothing in common
<asqui> hmmmm
<whee> well
<whee> instead of foo calling foo and adding that, how about have foo call foo2 and add foo2 up
<whee> while foo2 is tail recursive
<asqui> heh well fo2 would still have to be the same function... which presents you with the exact same problem when you try to make foo2 tail recursive!
<whee> and you have a point
<whee> heh
<asqui> recurson, it can work for you, but it can alo work against you :_
<asqui> THough if i did work out how to make it tail recursive that would be the cream pie on this lockdown.
<asqui> Just broke the 4000 word barrier. Muaahahahahahaha.
<asqui> Writing essays was so crap. Now i start writing about stuff I enjoy and I rack up 4000 words without even noticing.
docelic has joined #ocaml
docelic has quit ["later"]
lament has joined #ocaml
lament has quit ["mental mantle"]
lament has joined #ocaml
lament has quit ["mental mantle"]
mattam has joined #ocaml
<asqui> Is there any way to strip zeroes from a list using inbuilt functions or do i have to make my own?
mrvn has joined #ocaml
mrvn_ has quit [Read error: 60 (Operation timed out)]
graydon has left #ocaml []
<smkl> asqui: List.filter ((<>)0) ?
j_bravo has joined #ocaml
docelic has joined #ocaml
docelic has quit [Client Quit]
<asqui> smkl: Caml Light doesnt seem to have an equivalent. Ill just implement my own.
karryall has joined #ocaml
<asqui> Hmmmmm
<asqui> caml moans if i dont bracket h::l
<asqui> let filter f = fun [] -> [] | h::t -> if f h then h::t else t;;
<asqui> is a syntax error if i dont bracket that h::t!
<asqui> And this tutorial shows a very similar example of the rev function which uses the list constructor in a matching the exact same way, without brackets!
MegaWatS has joined #ocaml
<asqui> Bollcoks.
<asqui> let rec apply1 f i c out = fun [] -> out
<asqui> | (h::t) -> if i = c then (apply1 f i (c + 1) (f(h)::out) t);;
<asqui> This expression has type unit,
<asqui> but is used with type 'a list.
<MegaWatS> you have no else clause
<MegaWatS> so it is implicitly else ()
<MegaWatS> which has type unit
<asqui> ohhh
<asqui> how cunning
<asqui> would it be too hardcore if i somehow shadow f so that if i=c f=supplied f but if not i=c then f = fun x -> x so that wya i dont need the if statement there?
<MegaWatS> i dunno do as you like
<asqui> WOuld it be possible to do that?
<asqui> The only way I can shadow f is using "let f = ... in ..." right?
<MegaWatS> yep
<MegaWatS> I don`t see why you would want to, anyway
<asqui> so that I only have one place i call apply1 from
<MegaWatS> why?
<asqui> as it has loads of arguments and i dont really want to have "apply1 a b c d e f g else apply1 a b d f(e) f g
<asqui> (and to make it obfuscated... :)
<MegaWatS> i would do it with a when clause
<MegaWatS> but whatever
<asqui> when????
<MegaWatS> | h :: t when i = c ->
<MegaWatS> | h :: t ->
<asqui> that sounds halla useful.. why the hell havent we been taught the when yet....
<MegaWatS> you can always replace it with if / then / else
<MegaWatS> and you should usually not have too many when clauses in pattern matchings
<asqui> but thats icky
<MegaWatS> not really
<asqui> why is "fun out (h::t) -> " a syntax error?
<MegaWatS> it is?
<MegaWatS> no it isn`t
<asqui> let rec apply1 f i c = let cond = fun (f, u, v) -> if u=v then f else fun x -> x in
<asqui> fun out [] -> out |
<asqui> fun out (h::t) -> apply1 f i (c + 1) (out @ cond(f, i, c)) t;;
<MegaWatS> it only complains that the pattern-matching isn`t exhaustive
<MegaWatS> which it isn`t
<MegaWatS> I think you want function not fun
<MegaWatS> fun can only do one pattern matching afaik
<asqui> theres a difference???
<MegaWatS> yes
<MegaWatS> fun x y z ->
<MegaWatS> vs
<asqui> out isnt a patter match...
<MegaWatS> function x ->
<MegaWatS> but
<MegaWatS> yes it is
<MegaWatS> it is a always-match pattern
<MegaWatS> which binds the result to a variable
<MegaWatS> eg
<asqui> so fun can noyl ahve one variable or one vartesian product or one something only?
<asqui> function can have as many as you want?
<MegaWatS> no
<MegaWatS> it is exactly the opposite
<MegaWatS> fun can have as many as you like
<MegaWatS> but only one pattern for each variable
<MegaWatS> eg
<MegaWatS> you can do
<asqui> so why would i want function?
<MegaWatS> fun x y z ->
<MegaWatS> but not
<MegaWatS> fun x -> | y -> ...
<MegaWatS> but you can do
<MegaWatS> function x -> ... | y -> ... | ...
<MegaWatS> but not
<MegaWatS> function x y z ->
<MegaWatS> which is equivalent to function x -> function y -> function z -> ...
<MegaWatS> really, you should have been taught this :)
<asqui> how annoying
<MegaWatS> ?
<asqui> that hes mentioned nothing of this
<MegaWatS> they are two different function definition keywords with two different purposes
<MegaWatS> ic
<asqui> i just assumed fun was shorthand for function and that was that
smkl has quit [Read error: 104 (Connection reset by peer)]
<MegaWatS> well usually you should have been taught function only at first
smklsmkl has joined #ocaml
<MegaWatS> as fun is only a bit of syntactic sugar
<asqui> Why doy uo say i need function though?
<asqui> oh right...
<asqui> yeha i accidentally put in a space "fun" in there
<asqui> and if i changed the fun's to function's that would make it correct?
<asqui> is grok ja!
<MegaWatS> function is much like match
<MegaWatS> you can follow it by a (but only by one) pattern-matching
<MegaWatS> ie
<MegaWatS> function pattern -> expression | pattern -> expression ...
<MegaWatS> whereas fun takes several patterns, but can only match one case
<MegaWatS> ie
<MegaWatS> fun pattern pattern ... pattern -> expression
<asqui> what do you mean "Can only match one case" ?
<MegaWatS> exactly what I say
<MegaWatS> you can not have several cases
<MegaWatS> like
<MegaWatS> pattern1 -> expr1 | pattern2 -> expr2
xmkl has joined #ocaml
smklsmkl has quit [Read error: 104 (Connection reset by peer)]
<asqui> you can have fun (_,1) -> 1 | (x,_) -> x;; can't you?
<MegaWatS> no
<MegaWatS> you can only do that with function
<asqui> Wait a sec,m are you tlaking about caml light here?
<MegaWatS> no about ocaml
<asqui> right...
<asqui> Im working with Caml Light, sorry :)
<MegaWatS> oh sorry
<asqui> #fun (_,1) -> 1 | (x,_) -> x;;
<asqui> - : int * int -> int = <fun>
<MegaWatS> I don`t know about how it is in caml light
xmkl is now known as smkl
<asqui> I think its all fun, and you can do fun x y -> foo or you can do fun x -> fun y -> foo
<MegaWatS> I dunno, I only know ocaml sorry
<asqui> np
<asqui> sorry for the confusion
<asqui> hmmmm, problem....
<asqui> #let rec apply1 f i c =
<asqui> let cond = fun (f, i, i') -> if i = i' then f else fun x -> x in
<asqui> fun out [] -> out |
<asqui> out (h::t) -> apply1 f i (c + 1) (out @ cond(f, i, c) h ) t;;
<asqui> apply1 : ('a list -> 'a list) -> int -> int ->
<asqui> 'a list -> 'a list list -> 'a list = <fun>
<asqui> f is a function which i want to apply to one item of the list
<asqui> can f not be type int -> int somehow?
<asqui> perhaps if I replace "out @ cond(f, i, c) h " with "(cond(f, i, c) h :: out)" ?
<asqui> but then i need to reverse it at the end :(
<asqui> oh no, @ concatenates, therefore the second param needs to be a list
<asqui> i just whack a pair of []'s around it.
<asqui> excellent
lament has joined #ocaml
<asqui> map2 routesNd1 range(1,length(l)) (l);;
<asqui> > ^^^^^
<asqui> This expression has type int * int -> int list,
<asqui> but is used with type 'a list.
<asqui> Whats the problem?
<asqui> range(l, u) returns [l; l+1; l+2; ..., u]
lament has quit ["mental mantle"]
<smkl> try map2 routesNd1 (range (1,length l)) l
<asqui> This expression has type 'a list,
<asqui> but is used with type int.
<asqui> with hats pointing at the entire line
MegaWatS is now known as mathe^wats
<asqui> wit a minute
<asqui> i dont want map
<asqui> I want fold... or it_list even
<asqui> no no no...
<asqui> argh
<whee> heh
<asqui> rushing tog et this done :(
<whee> what's up now?
<asqui> just being silly and leaving out half the procedure :)
<asqui> shit
<asqui> i have a list [1;2;3] and a list [foobar]
<asqui> i want to apply MAGICALFUNC 1 [foobar] MAGICALFUNC 2 [foobar] and sotre the results in a list
<asqui> what do i do, what do i do?
<whee> haha
<whee> that's a job for map
<asqui> quick, this is not a laughing matter.
<asqui> but how
<asqui> im getting fucked up thinking about this 10 levels deep
<asqui> oh yeah it is a job of a map
<asqui> reatrd
<asqui> ive been trying to do map2,
<whee> heh
<kev> asqui: being offensive isn't going to make people want to help you you know
<whee> map (fun a -> magicalfun a) [foobar], right?
<kev> or maybe is it, kids these days...
<whee> wait no
<asqui> kev: Heh that comment was directed at myself
<whee> replace foobar with your [1;2;3] list and put [foobar] inside the fun
<whee> I would go and wrap that map inside another function that lets you specify the function/lists to use more easily
<whee> wooo these cs lab computers at least have hugs for me to play with :)
AndyA has joined #ocaml
mmc has joined #ocaml
lament has joined #ocaml
mattam_ has joined #ocaml
karryall has quit []
mattam has quit [Read error: 60 (Operation timed out)]
nkoza has quit [Read error: 60 (Operation timed out)]
mathe^wats has quit ["Actually, people sometimes talk about man's "bestial" cruelty, but that is being terribly unjust and offensive to the beasts:]
mathe^wats has joined #ocaml
mathe^wats is now known as PausenWatS
Yurik has joined #ocaml
<Yurik> re
<AndyA> hail
<AndyA> howdy?
<Yurik> AndyA: i'm well (more or less :))
<Yurik> AndyA: and how are you ?
<Yurik> AndyA: will you visit my seminar at Moscow? ;))
<AndyA> alas, i still don't know
Yurik_ has joined #ocaml
Yurik has quit [Read error: 104 (Connection reset by peer)]
<Yurik_> re
<AndyA> alas, i still don't know
<Yurik_> got disconnected :(
<Yurik_> have I missed something?
<AndyA> have small problems with customer :)
<Yurik_> ah ;) anyway, if you'll have a chance - you're welcome! :)
<AndyA> if i will clear issues i will come :)
<Yurik_> good
Yurik__ has joined #ocaml
Yurik__ is now known as Yurik
<Yurik> got disconnected again :(
PausenWatS is now known as mathe^wats
Yurik has quit [Read error: 104 (Connection reset by peer)]
Yurik_ has quit [Read error: 104 (Connection reset by peer)]
docelic has joined #ocaml
mattam_ has quit ["leaving"]
AndyA has left #ocaml []
mathe^wats is now known as MegaWatS
graydon has joined #ocaml
lament has quit ["mental mantle"]
docelic has quit ["Client Exiting"]
mattam has joined #ocaml
asqui has quit [Read error: 110 (Connection timed out)]
jemfinch has joined #ocaml
jemfinch has quit ["Client Exiting"]
jemfinch` has joined #ocaml
Ymrryr has joined #ocaml
graydon has quit ["xchat exiting.."]
jemfinch` has quit [Read error: 104 (Connection reset by peer)]
ElCritter has joined #ocaml
<ElCritter> hi
<whee> hola
<ElCritter> whee: hablas espanol?
<whee> no :)
<ElCritter> whee: :-D
<whee> my vocabulary for most languages other than english is limited to saying hello, heh
jemfinch` has joined #ocaml
<ElCritter> whee: do you know a good reference manual for caml light?
<ElCritter> whee: hmmm do you know another one? that seems to be the only one! :-)
<whee> nope
<ElCritter> brb
* ElCritter is away: intentando hacer este proyecto del orto...
<kev> anyone here use mgtk?
<MegaWatS> ?
<MegaWatS> whats that?
<kev> gtk for ml
<MegaWatS> isnt there already lablgtk for that?
<kev> possibly, I think mgtk might be mosml geared
MegaWatS has quit ["Actually, people sometimes talk about man's "bestial" cruelty, but that is being terribly unjust and offensive to the beasts:]
jemfinch` has quit [Read error: 104 (Connection reset by peer)]
malc has joined #ocaml
mellum has quit [Read error: 60 (Operation timed out)]
lament has joined #ocaml
malc has quit ["no reason"]
mellum has joined #ocaml
nkoza has joined #ocaml
docelic has joined #ocaml
asqui has joined #ocaml
jemfinch has joined #ocaml
jemfinch has quit [Client Quit]
jemfinch has joined #ocaml
Yurik has joined #ocaml
<Yurik> tr
<jemfinch> tr?
j_bravo has quit ["Trillian (http://www.ceruleanstudios.com)"]
<Yurik> eek
<Yurik> re
<Yurik> i mean
<jemfinch> hehe :)
<jemfinch> so how significant is it that SWIG now supports O'Caml?
<Yurik> not very significant
<Yurik> unfortunately
* jemfinch has pretty much converted to SML anyway, so it's a moot point.
<jemfinch> have you used the new polymorphic recursion feature?
<Yurik> SML sucks :))
<Yurik> recursion? what do you mean exactly?
<jemfinch> 3.05 added polymorphic recursion to the language, I was curious where that came in useful.
<Yurik> seems that I've not used it
<Yurik> i've used poly methods and records...
<jemfinch> why do you say that SML sucks?
<Yurik> it is not fast and not so usable as Ocaml
<jemfinch> but it's just so much cleaner :)
asquii has joined #ocaml
<Yurik> ocaml is a practical language
<Yurik> sml is a scientific one
<Yurik> so isn't very useful for production
<Yurik> asquiu hi
<whee> I don't like sml when compared to ocaml
<whee> I had reasons but I can't remember them anymore
<Yurik> compared to ocaml sml really sucks
<whee> it just seems that ocaml is much more powerful
<jemfinch> actually, I see it the other way around.
<Yurik> i've used to try sml/nj and found it very slow and inmature
<jemfinch> SML is much more practical, and O'Caml is much more scientific.
<jemfinch> that's why new, not-very-tested features get added at nearly every O'Caml release, whereas SML stays pretty much stable.
<whee> that's one reason I don't like SML
<kev> vim! emacs!
<whee> the language tends to sit there and not much changes because of the whole standards process
<jemfinch> SML has stuff like the CKit, and FoxNet, and such...it's used for some pretty large, industrial projects.
<whee> so improvements aren't as quick as they would be with ocaml
<jemfinch> whee: but then, I could argue that it doesn't need them as much, too :-P
<whee> I could argue that noone needs more than assembly, as it all gets compiled to that at some point :D
<jemfinch> I just like the naming scheme, the module structure, the syntax, and basically everything else a little better in SML. And stuff like Ckit and FLINT and MLRISC and CM and (especially) ml-nlffigen give me some fun things to play around with.
<whee> oh I remember why I decided to not learn SML now
<whee> I just don't like all the typing (literal typing, as in keyboard) :)
<whee> that and memory usage was high and sml/nj + ppc = not happening
Yurik has quit [Read error: 104 (Connection reset by peer)]
<jemfinch> whee: you mean how most functions are tupled instead of curried and whatnot?
<whee> and it didn't have some of the higher level features that I really like, like lazy lists
<whee> streams in ocaml there hurf
<jemfinch> hmm.../me thinks SML has lazy lists.
<whee> jemfinch: I don't know, I just look at SML programs and go "this is long"
<jemfinch> well, to each his own.
<jemfinch> I find it prettier to look at than O'Caml.
<whee> I don't know why they're longer, but I just don't like doing it that way
asqui has quit [Connection timed out]
asquii is now known as asqui
* SoreEel finds the revised syntax pleasing
<whee> yes, me too
<lament> mandatory 'else' is stupid
<jemfinch> lament: it's typesafe.
<whee> jemfinch: I'm just browsing that language shootout (evil yes) and comparing lines of code, and the smlnj versions are often quite larger than the equivalent ocaml or haskell version
<jemfinch> lament: SML also requires parentheses around multiple expression expressions.
<whee> I'm one of the types that doesn't want to use a functional language if it means writing tons of code to do simple things
<jemfinch> I doubt the shootout is an adequate representation of LsOC.
<whee> I don't see why not
<jemfinch> well, for one, because the same programmer didn't write the same code in both languages.
<whee> the entries are mostly written by people who actually have experience with the language, so they're not bad implementations