Revision17 has quit [Read error: 104 (Connection reset by peer)]
love-pingoo has joined #ocaml
kilimanjaro has quit ["leaving"]
rillig has quit ["exit(EXIT_SUCCESS)"]
Smerdyakov has quit ["Leaving"]
<flux__>
sometimes I wish let-kind of matches wouldn't complain about exhaustiveness - there is no way to rewrite those except as match-expressions to avoid that, right?
<love-pingoo>
flux__: maybe a camlp4 extension to add all the needed assert false ?
<flux__>
that would seem to me like a horrible workaround for something that could be a compiler switch (for warnings)
<love-pingoo>
flux__: but you can actually turn warnings off, right ?
<ketty>
you'll probably don't want to turn all warnings off =)
<love-pingoo>
I don't
<love-pingoo>
maybe flux__ wants to turn all non-exhaustive warnings off
<ketty>
in the revised syntax you can't even write unexhaustive let-matches...
<love-pingoo>
I'm not against that, I don't mind writing these assert false all around
<flux__>
love-pingoo, only the ones of form let xx = yy
<flux__>
love-pingoo, the ones with match xx with yy | zz should stay
<flux__>
because in the former you can never write a pattern match that matches multiple (different) cases, while with match you can
<flux__>
I guess you can actually write let ((A|B|C) c) = .. but I imagine that is of little help usually
<flux__>
and the situation where I would like the warnings to go away would be similar to let l = List.concat (List.filter (fun x -> match x with A x -> [x] | _ -> []) data) in List.map (fun (A x) -> x + 42) l
<flux__>
because in that case you need to again write that as a function pattern match (well, not that bad in that case) or a 'match' pattern match
<flux__>
and the extra case would only do what the compiler would do in any case: throw an exception
<love-pingoo>
I don't agree with the last bit, but what you say is sensible
<love-pingoo>
usually when one uses a let, the non-exhaustiveness is deliberate
rossberg has quit [Read error: 110 (Connection timed out)]
rossberg has joined #ocaml
ski has quit [Read error: 104 (Connection reset by peer)]
slipstream has quit [Read error: 104 (Connection reset by peer)]
slipstream has joined #ocaml
love-pingoo has quit ["Connection reset by by pear"]
ski has joined #ocaml
ramkrsna has quit ["Leaving"]
ramkrsna has joined #ocaml
chessguy2 has joined #ocaml
chessguy has quit [Connection timed out]
Revision17 has joined #ocaml
revision17_ has quit [Read error: 110 (Connection timed out)]
hikozaemon has quit [Client Quit]
systems has joined #ocaml
kral has joined #ocaml
mikeX has joined #ocaml
systems has left #ocaml []
<ski>
mikeX : patterns are not l-values
<mikeX>
:) I thought I was a bit wrong there too, but no one stepped up to correct me
<ski>
an l-value represent a (mutable) location, which one can read a value from, as well as write (mutate) a value into
<ski>
s/represent/represents/
<ski>
in ocaml, '=' is not assignment
Boojum has joined #ocaml
<ski>
a pattern is a certain restricted form of expression, which is "evaluated backwards", to get values for new variables (which are the ones that are inside the pattern)
<ski>
so matching against a pattern introduces new variables, with values that come from the value that was matched against the pattern
<ski>
in when assigning to an l-value, *already*existing* variables get mutated .. so this is different
<ski>
(s/in //)
<mikeX>
i see
gim_ has quit [Remote closed the connection]
kral has quit [No route to host]
mikeX has quit ["leaving"]
Boojum has quit ["Leaving"]
gim has joined #ocaml
cyyoung has joined #ocaml
zmdkrbou has quit [Read error: 110 (Connection timed out)]
zmdkrbou has joined #ocaml
cyyoung has quit ["This computer has gone to sleep"]
girodt has joined #ocaml
<girodt>
hi there
<ski>
hello
<girodt>
i've got a little problem with my code, and i can't find the source of it. it's a This expression has type stimulus list but is here used with type unit
<girodt>
i'm supposed to load data from a file, build my types from it and return the whole as a list.
<pango>
both branches of try/with must have the same type (even if one cannot be reached)
<pango>
add ; [] (* not reached *) after done, for example
<girodt>
ok
<girodt>
damnit ! you rock !
<pango>
or failwith "should not be reached"
<pango>
(failwith type is string -> 'a, so it will match any type)
<girodt>
ok
<ski>
it would maybe be nice if "while true do ... done" would get a polymorphic type "'a" since it can't return .. (or is there a "break" for OCaml while-loops ?)
<pango>
ski: not afaik, only exceptions
<ski>
ok, that that is not normal return, so it's ok
<ski>
there's already a special case similar to this .. 'assert false'
<pango>
right
<ski>
# fun b -> assert b;;
<ski>
- : bool -> unit = <fun>
<ski>
# fun () -> assert false;;
<ski>
- : unit -> 'a = <fun>
<girodt>
this chan is of great help thank you guys
<pango>
np
pg_ has joined #ocaml
Smerdyakov has joined #ocaml
<girodt>
hey again. I've got a linking error. "Reference to undefined global `Math'" in my working directory, i've got 3 files : "dataset.ml", "neuron.ml" and "math.ml". In neuron.ml, I use both others. Everything works regarding "Open Dataset" but not for "Open Math".
<Smerdyakov>
Sounds like you have the files linked in the wrong order.
<girodt>
great !
<girodt>
you were right. i had to put math.ml before neuron.ml in my makefile
<girodt>
thanks again
finelemo1 has joined #ocaml
finelemon has quit [Read error: 110 (Connection timed out)]
Schmurtz has quit [Remote closed the connection]
<girodt>
see you tomorrow people.
<girodt>
bye
girodt has quit ["leaving"]
Oatmeat|umn has quit [Read error: 110 (Connection timed out)]
Oatmeat|umn has joined #ocaml
chessguy has joined #ocaml
ski has quit [Read error: 110 (Connection timed out)]
ski has joined #ocaml
jcreigh has joined #ocaml
altDanly has joined #ocaml
pinupgeek has joined #ocaml
Smerdyakov has quit [kornbluth.freenode.net irc.freenode.net]
zmdkrbou has quit [kornbluth.freenode.net irc.freenode.net]
Revision17 has quit [kornbluth.freenode.net irc.freenode.net]
serge has quit [kornbluth.freenode.net irc.freenode.net]
ketty has quit [kornbluth.freenode.net irc.freenode.net]
mlh has quit [kornbluth.freenode.net irc.freenode.net]
altDanly has quit [kornbluth.freenode.net irc.freenode.net]
ski has quit [kornbluth.freenode.net irc.freenode.net]
chessguy has quit [kornbluth.freenode.net irc.freenode.net]
Oatmeat|umn has quit [kornbluth.freenode.net irc.freenode.net]
pg_ has quit [kornbluth.freenode.net irc.freenode.net]
gim has quit [kornbluth.freenode.net irc.freenode.net]
slipstream has quit [kornbluth.freenode.net irc.freenode.net]
julbouln has quit [kornbluth.freenode.net irc.freenode.net]
bohanlon has quit [kornbluth.freenode.net irc.freenode.net]
cmeme has quit [kornbluth.freenode.net irc.freenode.net]
Lob-Sogular has quit [kornbluth.freenode.net irc.freenode.net]
TaXules has quit [kornbluth.freenode.net irc.freenode.net]
creichen has quit [kornbluth.freenode.net irc.freenode.net]
jcreigh has quit [kornbluth.freenode.net irc.freenode.net]
shawn has quit [kornbluth.freenode.net irc.freenode.net]
bzzbzz has quit [kornbluth.freenode.net irc.freenode.net]
mellum has quit [kornbluth.freenode.net irc.freenode.net]
avlondono has quit [kornbluth.freenode.net irc.freenode.net]
shrimpx has quit [kornbluth.freenode.net irc.freenode.net]
ramkrsna has quit [kornbluth.freenode.net irc.freenode.net]
descender has quit [kornbluth.freenode.net irc.freenode.net]
sieni has quit [kornbluth.freenode.net irc.freenode.net]
Amorphous has quit [kornbluth.freenode.net irc.freenode.net]
Demitar has quit [kornbluth.freenode.net irc.freenode.net]
vincenz has quit [kornbluth.freenode.net irc.freenode.net]
mattam has quit [kornbluth.freenode.net irc.freenode.net]
dvekravy has quit [kornbluth.freenode.net irc.freenode.net]
danly has quit [Success]
metaperl_ has joined #ocaml
smimou has joined #ocaml
gim_ has joined #ocaml
khaladan has joined #ocaml
altDanly has joined #ocaml
jcreigh has joined #ocaml
ski has joined #ocaml
chessguy has joined #ocaml
Oatmeat|umn has joined #ocaml
Smerdyakov has joined #ocaml
pg_ has joined #ocaml
zmdkrbou has joined #ocaml
gim has joined #ocaml
Revision17 has joined #ocaml
ramkrsna has joined #ocaml
slipstream has joined #ocaml
serge has joined #ocaml
mlh has joined #ocaml
shawn has joined #ocaml
ketty has joined #ocaml
julbouln has joined #ocaml
descender has joined #ocaml
creichen has joined #ocaml
bohanlon has joined #ocaml
bzzbzz has joined #ocaml
sieni has joined #ocaml
Amorphous has joined #ocaml
avlondono has joined #ocaml
Demitar has joined #ocaml
mellum has joined #ocaml
vincenz has joined #ocaml
cmeme has joined #ocaml
Lob-Sogular has joined #ocaml
TaXules has joined #ocaml
mattam has joined #ocaml
dvekravy has joined #ocaml
shrimpx has joined #ocaml
jcreigh_ has joined #ocaml
dvorak_ has joined #ocaml
dvorak has quit [Connection reset by peer]
jcreigh has quit [Connection timed out]
ski has quit [Read error: 110 (Connection timed out)]
ski has joined #ocaml
metaperl has quit [Connection timed out]
Schmurtz has joined #ocaml
jcreigh_ has quit ["Do androids dream of electric sheep?"]
ski has quit [Read error: 110 (Connection timed out)]
ski has joined #ocaml
pg_ has quit ["Leaving"]
shrimpx has quit [Read error: 104 (Connection reset by peer)]
ski has quit [Connection timed out]
ski has joined #ocaml
ski has quit [Read error: 104 (Connection reset by peer)]
altDanly is now known as danly
pinupgeek has quit []
shawn has quit ["This computer has gone to sleep"]
shawn has joined #ocaml
shawn has quit [Client Quit]
shawn has joined #ocaml
Snark has joined #ocaml
exa has joined #ocaml
Revision17 has quit ["Ex-Chat"]
multani has joined #ocaml
Revision17 has joined #ocaml
exa has quit [Remote closed the connection]
exa has joined #ocaml
Sir_Diddymus has joined #ocaml
stockholm has joined #ocaml
<stockholm>
Hello, I am currently working on a project which needs to have multiple threads, one of which is a display thread. I have tried to get the glut library to work with the ocaml thread library, but this does not seem to work. The glut thread just takes over, and will not yield to the other thread. I have also tried to get the desired behavior using the sdl library, but got even worse results. Does anyone have any recommendatio
<stockholm>
ns / advice, thanks for your time.
<ketty>
stockholm: i have had no problems with sdl and threads in the past...
ged_ has joined #ocaml
<ged_>
hi
<ged_>
i've a problem with ocaml
<ged_>
can anybody help me?
<ketty>
maybe :)
<stockholm>
ketty: Have you gotten multiple threads to make sdl calls
<ged_>
ok, so i'm writing a board game
<ketty>
well.. my design was a mess... i had several hundreds of threads :)
<stockholm>
ketty: Or, do you know of somewhere with some example code?
<ged_>
state of board is represented by a mutable record:
<ged_>
type state = { mutable plansza: board; mutable spressed: bool; mutable who: int; mutable ilu:int; mutable w:int; mutable k: int; mutable gracze: int list };;
<ged_>
to implement moveing back
<ged_>
i put states on stack
<ged_>
then pop them out
<ketty>
stockholm: no, i don't know right now... sorry
<stockholm>
ketty: thats cool. well, now that i know it has been done, its just up to me to try a little harder. thanks for your time.
<ged_>
but due to shareing all records on stack are same as the current one
<ged_>
how to fix that?
<ketty>
ged_: it would be easier with functional records :)
<ged_>
i've a lot of code using imperative ones..
<ged_>
so i don't want to change the whole program
<ketty>
you need to create new records and not just binding existing ones to new variables
<ged_>
i tried:
<ged_>
let save_move () = let copy = {!myBoard with plansza=(!myBoard.plansza)} in Stack.push copy sStack;;
<ged_>
but it doesn't work either ;/
<ketty>
{... with ...} shares values with the old record...
<ged_>
ketty: so what do you propose?
<ketty>
you could make a copy function that manualy copied all fields of a record...
<ketty>
i don't know if there is a more easy way to do it, since i don't use such features much myself :)
<ged_>
i'm too much poisoned with imperative style i guess ;)
<ketty>
:)
<ged_>
so, fun rec -> {plansza=rec.plansza; ....; field=rec.field
<ged_>
}
<ged_>
would do?
<ketty>
except rec is a reserved keyword :)
<ged_>
;p
<ged_>
i'll check this
Snark has quit ["Leaving"]
<ged_>
doesn't work
<ged_>
fields are still shared ;/
<ketty>
ged_:
<ketty>
# type t = { mutable i : int };;
<ketty>
type t = { mutable i : int; }
<ketty>
# let a = {i = 5} in let b = {i = a.i} in a.i <- 7; (a.i, b.i);;
<ketty>
- : int * int = (7, 5)
exa has quit [Remote closed the connection]
multani has quit ["Parti"]
<pango>
the problem arise when fields are references
<ketty>
oh, sorry. didn't notice that!
<pango>
if you copy a reference, both still refer to the same object
Revision17 has quit [Read error: 104 (Connection reset by peer)]
<ged_>
type static = {p: board; wh:int; il:int; gracz: int list};;
<ged_>
let copy r = {p=r.plansza; wh=r.who; il=r.ilu; gracz=r.gracze};;
<ketty>
what is the type of board?
Revision17 has joined #ocaml
<ged_>
cell array array
<ketty>
hmm.. you still have problems?
<pango>
then you'll have to deep copy boards
<ketty>
ahh..
<ged_>
but other fields become shared too
<ged_>
not only board
<pango>
should be a problem with int, which is not a reference
<pango>
and with int list, because it's immutable
<ketty>
can you post an example on a pastebin?
<pango>
s/should/should not/ (sorry)
<ged_>
w8
<pango>
don't know the type of other fields, but some may require deep copying too
<pango>
the wonders of backtracking using mutable structures
<ged_>
# open Board;;
<ged_>
# copy !myBoard;;
<ged_>
- : Board.static = {p = [||]; wh = 1; il = 0; gracz = []}
<ged_>
# let c = copy !myBoard;;
<ged_>
val c : Board.static = {p = [||]; wh = 1; il = 0; gracz = []}
<ged_>
# c.p == !myBoard.plansza;;
<ged_>
- : bool = true
<ged_>
# c.wh == !myBoard.who;;
<ged_>
- : bool = true
<ged_>
!myBoard.who is int
* ketty
tells ged_ about pastebin.com :)
<ged_>
ok
<ketty>
and if you do myBoard.who := 5
<ketty>
c.wh does not get changed, right?
<ged_>
yes
<ged_>
but why
mikeX has joined #ocaml
<ketty>
so.. is there a problem? :)
<ged_>
aren't they in the same place in memory?
<ketty>
! is an operator
<ketty>
hmm..
<ketty>
yes the content of the reference is the same as c.wh
<ketty>
but when you use ":=" you make the reference "point" to another location...
<ketty>
really.. you should not use references, they are confusing =)
<Schmurtz>
I think there is an algorithm to make a nul game
<ged_>
board.ml + gui.ml + stelary.ml + main.ml
<ged_>
you can play human vs human ;)
<ketty>
no ai? :)
<ged_>
press 's' to but a blocade on grid
<ged_>
i'm struggling with moving back atm
<ged_>
i've an idea for ai
<ged_>
but minimax is pretty useless in this game, too much branches
<ketty>
i did a crappy gui for the "go" back when i was still thinking imperatively...
<ketty>
s/the "go"/"go"
<ketty>
it had human vs. human, human vs. ai and ai vs. ai
<ketty>
and unlimited undo...
<ketty>
but the code was a mess :)
<ged_>
just like mine now ;p
<ketty>
(it even had network play ^^)
<pango>
there's a chapter on 2 players games in "developing applications with objective caml", but it uses functors, and other advanced stuff that you may not have seen yet
smimou has quit ["bli"]
<ketty>
ged_: are you sure the problem is not only with plansza?
<ketty>
(when you try to back)
<ged_>
no, i'm too tired to check now
<ged_>
i'm fighting with this all day
* ketty
tells ged_ about Array.map and Array.copy and goes to bed :)
<ged_>
ketty tnx for your help
ged_ has quit []
<Sir_Diddymus>
Hi all... If i define a function like: let rec fn f = function ...;; does this imply that the parameter f (if stated) can only be a function (with one parameter), and the match is done against that parameter? (please excuse bad english ;)
<Sir_Diddymus>
'cause i don't understand why both versions work then: http://pastebin.com/732087 (or is this too rtfm?)
<mikeX>
let fn = function ... equals let fn f = match f with ...
<Sir_Diddymus>
but how does "i :: l" match "p a"? Or how does it work when i pass two parameters in the form of "each2 p a"?
<Sir_Diddymus>
or better said, of does "i :: l" match f, since f is "p a"...?
<Sir_Diddymus>
s/of/how/
<ketty>
Sir_Diddymus: it does not match both arguments..
<mikeX>
Sir_Diddymus: i'm not sure I understand your problem
<ketty>
(function [] -> 0 | _ -> 5) equals (fun x -> match x with [] -> 0 | _ -> 5)
<ketty>
(let f a = function ....) equals (let f a b = match b with ....)
<Sir_Diddymus>
ketty: hm... ok, i understood it somehow wrong it seems. (let f = function ...) confused me, since it seems to be the same as (let f a = match a with ...).
<ketty>
it is :)
<mikeX>
which brings to rtfm on functions in ocaml Sir_Diddymus
<Sir_Diddymus>
ketty: so how does the compiler know, that with (let f a = function ....) equals (let f a b = match b with ....) it has to match against "b"? Because f is a function and not a list?
<pango>
because it's the last parameter
<ketty>
"function" adds an unnamed parameter...
<pango>
or rather, an anonymous function of one unnamed parameter
<pango>
let f a = function ... <=> let f a = (fun b -> match b with ... )
<Sir_Diddymus>
ahh! that was the missing link i think. Always the last parameter? Even if there a two (let f a b = function ...)?
<ketty>
Sir_Diddymus: do you know about currying?
<mikeX>
ma ti na dokimaso? les na min to dokimasa? pos evala paketa
<mikeX>
oops, wrong window :)
<pango>
let f a b = function ... f is then a function of 3 parameters
<Sir_Diddymus>
ketty: yes read about it, but since it's my second day i play with ocaml and i
<pango>
ketty: yes, semantically at least; the compiler tries to optimize that :)
<Sir_Diddymus>
so i think i'll get it.... :)
<mikeX>
Sir_Diddymus: if you feel uneasy with it at the moment, don't use it (the function -> construct)
<mikeX>
stick with what makes sense to you from your previous (I suppose imperative background), in time you'll get to the bottom of it :)
* pango
tries to avoid 'function' whenever he can, finding it confusing too
* ketty
likes it :)
<mikeX>
well I like to use it for single argument functions
<pango>
it doesn't really help readability, and it's not really a typing gain, since it's a long keyword anyway ;)
<ketty>
in the revised syntax it is just "fun" =)
<mikeX>
writing 'let f a = match a with' feels a bit redundant
<mikeX>
but you do have a point pango
<pango>
I don't mind the redundancy there
<Sir_Diddymus>
mikeX: yup, thanks...
<pango>
only for very simple functions
<pango>
like let rec length = function [] -> 0 | h :: q -> length q + 1 and such
<Sir_Diddymus>
now my brain smokes anyway and i need to go to bed. I even have a bigger thingy i don't get - when i replace the one ";" in each2 with "::" it works as well, but in reverse. But that's for another day... :D
<Sir_Diddymus>
anyway, thanx all for your patience...