<flux>
it shouldn't end up into an infinite loop I suppose?
<thelema>
yes, it shouldn't end up in an infinite loop
<thelema>
normally, the only infinite loops that would occur are when running canonize on each of the "child" regexes
<thelema>
but when trying to canonize (a?)* it gets into an infinite loop inside canonize (not in the process of making a DFA)
<thelema>
Canonizing: (a|Eps)*
<thelema>
(Eps = epsilon)
<thelema>
Canonizing: (Eps|(a|Eps)(a|Eps)*)
* thelema
doesn't want to paste too much
Alpounet has joined #ocaml
<thelema>
maybe I still need to figure out what output I expect from this situation
<thelema>
(a?)* -> a(a?)*
<thelema>
hmm, maybe I need a 'non-empty match' flag...
<thelema>
to force a? to not be empty
ikaros has quit [Read error: 113 (No route to host)]
ikaros has joined #ocaml
julm_ is now known as julm
Waleee has joined #ocaml
ski_ has quit ["Lost terminal"]
<ygrek>
anyone using ocaml-mysql here?
<ygrek>
Looks like it is full of potential bugs
<ygrek>
see http://paste.defun.ru/m423203aa, passing address to ocaml heap (String_val(newdb)) and releasing runtime lock - can be fatal, right?
<ygrek>
(in multithreaded code)
* thelema
doesn't know
<ygrek>
race condition, if gc starts compacting (in another thread) and moves ocaml value before libmysql reads the string - crash (or wrong result in the worst case)
<ygrek>
and such code is all over the whole library
Walee has joined #ocaml
<ygrek>
and the same code in the recent debian "security" patch..
<thelema>
doesn't the runtime lock keep compaction away while it's being used?
<thelema>
newdb isn't used outside the blocking section
<ygrek>
enter_blocking_section releases lock
<ygrek>
anyway, I am fixing this, in case anyone is interested (and unfortunately I am unable to reach Shawn Wagner by email)
<thelema>
really? :(
<ygrek>
yes
Waleee has quit [Connection timed out]
munga_ has quit [Read error: 148 (No route to host)]
Alpounet has quit ["Leaving"]
Waleee has joined #ocaml
antegallya has joined #ocaml
Alpounet has joined #ocaml
Walee has quit [Read error: 110 (Connection timed out)]
Waleee has quit [Read error: 60 (Operation timed out)]
ttamttam has joined #ocaml
mattam has joined #ocaml
monestri has joined #ocaml
<monestri>
is there any way to recall previous statements in the ocaml interpreter?
<thelema>
rlwrap ocaml
<monestri>
hm, ok i'll give that at ry
<monestri>
thanks
<thelema>
one day we might get a distribution of ocaml with that built in. INRIA seems to have no interest in this, though.
<Camarade_Tux>
crap, my C integers are 32bits-wide while my ocaml-ones are 64bits-wide
antegallya has quit ["Leaving"]
Associat0r has joined #ocaml
Submarine has joined #ocaml
Snark has quit ["Ex-Chat"]
<Camarade_Tux>
god, I really hate gobject-introspection
tmaeda is now known as tmaedaZ
onigiri has quit []
<julm>
Camarade_Tux, acknowledged
<Camarade_Tux>
every time something is missing, I need to fix run g-ir-scanner again, fix its output and discover something else is missing
<Camarade_Tux>
and its output is between 2000 and 6000 lines long
<hcarty>
thelema: Lwt 2.0 has line editing + history support for the toplevel
<hcarty>
thelema: Without the need for out side tools - just '#require "lwt.top";;' once Lwt is installed.
<hcarty>
s/side/outside/
<Camarade_Tux>
hcarty: do you know how they achieve this?
<hcarty>
Camarade_Tux: The ocaml-text module and some of the Top* modules
<Camarade_Tux>
would be nice to have that extracted in a separate library :)
<hcarty>
It's similar to rlwrap's support, and it supports tab-completion. The code to hook in to the completion routines looks fairly straightforward so it may provide a nice base for (semi)intelligent tab-completion in the toplevel.
<hcarty>
Camarade_Tux: I think it is, within the Lwt codebase and installed packages.
<hcarty>
I have only toyed with it a little bit so far though.
<hcarty>
I don't know what license issues may come up. I think the Top* modules are under the delightfully archaic QPL.
<hcarty>
Between the Lwt efforts and Cameleon's toplevel GUI wrapper there are some very nice toplevel enhancements around right now.
Associat0r has quit []
<hcarty>
Are there any OSX users here? A PLplot user is getting some odd linking errors on OSX and I don't have Mac to test on.
<monestri>
let get_head l = match l with [] -> [] | (h::t) -> h;; <-- am I not allowed to return an empty list or an integer in the same function?
onigiri has joined #ocaml
<monestri>
because of static typing or what not?
<flux>
monestri, correct. you might want to use option types or exceptions in that case
ygrek has quit [Remote closed the connection]
Submarine has quit ["Leaving"]
<monestri>
i'm a bit confused about (h::t) inside match. I get that' it's matching a list with a head and a tail, but could I let e = 2 let l = [1;2;3] and match l with (e::t) -> e to return 2?
<monestri>
ugh, um.. that's wrong
<Camarade_Tux>
it'd return 1
<monestri>
yeah
<Camarade_Tux>
the name of the variable has no influence there
<monestri>
so i have to do something like (h::t) -> if h = e...?
<Camarade_Tux>
well, you can do
<Camarade_Tux>
match [1; 2; 3] with
<Camarade_Tux>
| h::t when h = e -> e
<Camarade_Tux>
...
<Camarade_Tux>
it's basically the same
<Camarade_Tux>
it's only available in ocaml btw, not caml light or friends
<monestri>
oh okay
<monestri>
is there any difference between (h::t) and h::t ?
<flux>
no
<flux>
well, unless t is followed by something, or h preceded
<flux>
for example a h::t would be an illegal pattern, but it would be a legal expression meaning (a h)::t
<monestri>
function a with parameter h?
<flux>
function a would be called with h as its first parameter, yes
slash_ has joined #ocaml
<monestri>
do you get a match failure when there's no matching pattern?
<monestri>
I thought the interpreter checks to see if it's exhaustive before you use it
<monestri>
let find l e = match l with [] -> -1 | h::t when h = e -> e | h::t -> find t e;; <-- function i'm playing around with
<monestri>
works for 1 and 2, but not 3. i.e. find [1;2;3] 3
<Camarade_Tux>
monestri: it checks and warns you
<Camarade_Tux>
it can't always check for exhaustiveness when you have "when" clauses
<monestri>
hmm ok
<_YKY_>
Hello... I'm looking for someone who can implement higher-order unification
<monestri>
find [1;2;3] 3 -> find [2;3] 3 -> find [3] 3 -> not sure what happens here
<monestri>
i'm assuming it's supposed to trigger then when e = 3, but i guess not?
<monestri>
huh, maybe it is working now
<monestri>
# find [1;2;3] 3;; Exception: Match_failure ("", 12, -28), but now it's working.. pretty sure I didn't change the function
<Camarade_Tux>
monestri: you need a "let rec"
<monestri>
oh, forgot about that
<Camarade_Tux>
what you see it find not-calling itself but calling a previous definition of a function name "find"
<monestri>
oh i see
<monestri>
so when I entered the same function twice, it was calling the previous find, so it worked
<monestri>
but when I only had it entered once, it was calling a bad find
<Camarade_Tux>
yeah
<monestri>
ocaml has to be the most entertaining language i've had to learn :D
erickt has quit [Read error: 104 (Connection reset by peer)]
erickt has joined #ocaml
erickt has quit [Read error: 104 (Connection reset by peer)]
erickt has joined #ocaml
sramsay has joined #ocaml
erickt has quit [Read error: 104 (Connection reset by peer)]
ttamttam has quit ["Leaving."]
<monestri>
when writing recursive functions in other languages.. you typically use helper functions if they have different parameters
<monestri>
is it more common to use two separate functions or to nest them in ocaml?
<Camarade_Tux>
good questions, I think separate is more common but I know of no general rule
antegallya has joined #ocaml
<monestri>
and i'm assuming the helper function should come first if you're using the interpreter
<monestri>
does it matter for the compiler?
<albacker>
i think in ocaml is more common nested from code i've seen, but i'm a beginner so.
<Camarade_Tux>
monestri: since you can't separate the declaration from the implementation, the helper function always has to come first, no matter if you're using the toplevel or one of the compilers
jeddhaberstro has joined #ocaml
antegallya has left #ocaml []
antegallya has joined #ocaml
<monestri>
how would I do multiple expressions after a pattern?
<monestri>
i.e. | h::t when h = e -> let i = 5; foo(t);;
<Camarade_Tux>
just write code as you would write anywhere else
<thelema>
let i = 5 in foo t
<Camarade_Tux>
which means "let ... in" or ";", not a mix of the two ;-)
<monestri>
i think i meant to do..
<monestri>
let i = 5; foo t i
<monestri>
is let i = 5 in foot t similer to that?
<monestri>
i know ; executes the first, discards the return value, and then executes the second
<thelema>
yes.
<monestri>
and i think the in limits the scope or something
<thelema>
there's no return value for "let i = 5" - there is a return value for "let i = 5 in foo" -- the return value is foo
albacker has quit ["-"]
lagenar has joined #ocaml
antegallya has quit [Connection reset by peer]
antegallya has joined #ocaml
lagenar has left #ocaml []
antegallya has quit [Read error: 131 (Connection reset by peer)]
antegallya has joined #ocaml
struktured has quit [Read error: 110 (Connection timed out)]
<monestri>
let foo a b = a + b;;
<monestri>
why isn't foo 2+2 1+1;; valid?
<monestri>
but foo (2+2) (1+1);; is?
<thelema>
because foo 2 + 2 1 + 1 is too many arguments for foo.
<monestri>
that's not what I typed tho ;p
<monestri>
oh ok, fine
<thelema>
its the same as what you typed
<monestri>
i guess it's the same
<thelema>
actually, it's not quite...
<monestri>
still, can't it simply each expression?
<antegallya>
function evaluation take highest precedance
<thelema>
it's (foo 2) + (2 1) + (1)
<thelema>
which doesn't make sense.
<thelema>
+ has lowest precedence, function application is highest
<thelema>
so you could do foo 2 3 + foo 3 2
<monestri>
ok
<monestri>
spent 20 minutes figuring this out lol =[
<thelema>
the real trouble is when you want to do [foo -1], and you have to write [foo (-1)]
<monestri>
why's that a problem?
<monestri>
compiler catches the former and the latter seems to work
<thelema>
the latter works, but the former looks like there's no problem.
<thelema>
it slips by the eyes
<monestri>
# let a = [foo -1];; This expression has type int -> int but is here used with type int
<thelema>
[] is just to block off code.
<thelema>
let a = foo (-1);;
<thelema>
let a = foo -1;; (* same as: foo - 1 *)
<monestri>
oh yeah, agreed
<monestri>
this was actually my problem
<monestri>
which is why I didn't catch it later
<monestri>
my initial function was foo a b i+1, which actually returned the correct result for whatever reason
<monestri>
and then I later had to do foo a i+1 b, and couldn't figure out what the heck was going wrong ;/
<thelema>
(foo a b i)+1
<monestri>
right
smimou has quit ["bli"]
<monestri>
do you access elements in a touple using match?
<antegallya>
you can
<antegallya>
you can also deconstruct it with something like let a,b = 2-uple
<monestri>
val l : ((int * int) * (int * int)) list = [((1, 2), (3, 4))]
<monestri>
is this a list of touples, or a list with a touple that has 2 touples inside of it?
<monestri>
bah, nm. forgot to add the ; in the list
<antegallya>
the latter
<monestri>
trying to do something like match l with (a,b) -> a;;
<antegallya>
but you're trying to do that with a list ?
<monestri>
rather, the first element in the first touple of list l
_YKY_ has quit [Read error: 110 (Connection timed out)]
<monestri>
yes
<Camarade_Tux>
[ match l with (a,b)::t -> a ] ?
<Camarade_Tux>
and you can use "_" for arguments you don't care about instead of naming them: [ match l with (a, _) :: _ -> a ]
<monestri>
what's with the []?
<monestri>
oh, seperating code?
<antegallya>
a list
<monestri>
oh
<monestri>
alright, close heh, thanks
<Camarade_Tux>
monestri: yeah, it was to show code
struktured has joined #ocaml
ofaurax has quit ["Leaving"]
<monestri>
let rec bar l l1 l2 = match l with [] -> (l1,l2) | (x,y)::t -> foo(l1, [x]); foo(l2, [y]); bar t l1 l2;;
<monestri>
is splitting the function calls with; ok?
<monestri>
getting l2;;ing S: this expression should have type unit.
<Camarade_Tux>
what is foo?
<monestri>
let rec foo (l, m) = match l with [] -> m | (x::xs) -> x::(append (xs, m)) ;;
<monestri>
rather, let rec foo (l, m) = match l with [] -> m | (x::xs) -> x::(foo (xs, m)) ;; :)
<Camarade_Tux>
maybe because it's late here but it looks pretty complicated
<monestri>
hm.. i'll try to make a test case
<Camarade_Tux>
also, name your functions with names more explicit than "foo" and "bar", that usually makes it easier to read code :D
<Camarade_Tux>
foo (l, m) reverses the list l but returns m
<Camarade_Tux>
argh, no
* Camarade_Tux
wonders where he left his glasses
<antegallya>
foo (l,m) appends l to m
<Camarade_Tux>
but as I thought, foo (l1, [x]) is a useless computation
<Camarade_Tux>
the results isn't used at all
<Camarade_Tux>
and actually, foo (l, m) appends m to l
<Camarade_Tux>
monestri: foo (l1, [x]) doesn't change the list l1, it creates a new one
<Camarade_Tux>
you probably want:
<Camarade_Tux>
let l1' = foo (l1, [x]) in let l2' = foo (l2, [y]) in bar t l1' l2'
<Camarade_Tux>
(yes, you can name it l1' but I'm not sure it's really advised)
<monestri>
all that inside of the -> ?
<Camarade_Tux>
sure
<antegallya>
(and btw you can use the @ operator to concatenate lists : l1@l2)
<Camarade_Tux>
and preferably on three different lines ;-)
<monestri>
hmm, i think it was the ;'s that were tripping me up
<monestri>
replacing them with in's works
onigiri has quit []
<monestri>
does that have anything to do with let x = 1 let y = 3 and not needing a ;; until you're done?
<monestri>
nevermind
sramsay has quit ["Leaving"]
<Camarade_Tux>
going to bed before my eyes die, good night :)
<antegallya>
Camarade_Tux, 'night
valross has joined #ocaml
struktured has quit [Remote closed the connection]
<monestri>
with (foo f a), how does ocaml know if it's foo (f a) with one parameter or foo f a with two?
spicey has joined #ocaml
struktured has joined #ocaml
<antegallya>
ocaml knows the signature of foo and try to expand the arguments as much as possible
<monestri>
so assuming foo is a function with two parameters and f with one
<monestri>
it won't try to evaluate f a?
<antegallya>
if foo as one parameter, (foo a b) is equiv to ((foo a) b) and if it has two parameters, it is equivalent to (foo a b)
<antegallya>
f will be considered the first argument of foo and a the second one
<antegallya>
you can easily test things like that.
<spicey>
i have my own structure of {x, y, z} and i'm trying to call function that expects ~x, ~y, ~z as parameters instead - in a generic way. i'm unsuccessful, though, and I can't figure out what does it want from me: http://codepad.org/DNVTAlTg
<antegallya>
if f was [ val f : 'a -> 'a ] and foo was [val foo : ('a -> 'a) -> 'a -> 'a] then if [ foo f a ] was evaluated as [ foo (f a) ] it would give you an error
<antegallya>
spicey was is the type of GlMat.translate ?
ikaros has quit ["Leave the magic to Houdini"]
<antegallya>
oh yes, ?x:float -> ?y:float -> ?z:float -> unit -> unit