emmanuelux has quit [Remote host closed the connection]
zpe has quit [Ping timeout: 248 seconds]
j0sh has quit [Remote host closed the connection]
morolin has joined #ocaml
j0sh has joined #ocaml
talzeus has quit [Remote host closed the connection]
zpe has joined #ocaml
zpe has quit [Ping timeout: 245 seconds]
<pippijn>
what happens when two cyclic blocks with finalisers are garbage collected?
madroach has quit [Ping timeout: 264 seconds]
madroach has joined #ocaml
talzeus has joined #ocaml
ygrek has joined #ocaml
<bernardofpc>
the universe splits in as many copies as needed ?
zpe has joined #ocaml
zpe has quit [Ping timeout: 245 seconds]
ygrek has quit [Ping timeout: 248 seconds]
j0sh has quit [Remote host closed the connection]
q66 has quit [Quit: Leaving]
shinnya has quit [Ping timeout: 248 seconds]
zpe has joined #ocaml
zpe has quit [Ping timeout: 256 seconds]
j0sh has joined #ocaml
ygrek has joined #ocaml
zpe has joined #ocaml
ihm1 has joined #ocaml
zpe has quit [Ping timeout: 245 seconds]
wagle_ has joined #ocaml
callen_ has joined #ocaml
dkg_ has joined #ocaml
Cypi_ has joined #ocaml
dkg has quit [*.net *.split]
wagle has quit [*.net *.split]
ivan\ has quit [*.net *.split]
fayden has quit [*.net *.split]
callen has quit [*.net *.split]
Cypi has quit [*.net *.split]
ivan\_ has joined #ocaml
mcclurmc has joined #ocaml
Xom has quit [Read error: No buffer space available]
Xom has joined #ocaml
ivan\_ has quit [Excess Flood]
ivan\ has joined #ocaml
ivan\ has quit [Changing host]
ivan\ has joined #ocaml
zpe has joined #ocaml
fayden has joined #ocaml
zpe has quit [Ping timeout: 256 seconds]
gour has joined #ocaml
zpe has joined #ocaml
dkg_ is now known as dkg
mcclurmc has quit [Quit: Leaving.]
ihm1 has quit [Quit: ihm1]
zpe has quit [Ping timeout: 245 seconds]
shinnya has joined #ocaml
yacks has quit [Quit: Leaving]
callen_ is now known as callen
callen has quit [Changing host]
callen has joined #ocaml
dlovell has quit [Read error: Connection reset by peer]
chrisdotcode has quit [Ping timeout: 256 seconds]
zpe has joined #ocaml
zpe has quit [Ping timeout: 264 seconds]
chrisdotcode has joined #ocaml
ihm1 has joined #ocaml
ben_zen has quit [Ping timeout: 264 seconds]
Cypi_ is now known as Cypi
zpe has joined #ocaml
csakatoku has joined #ocaml
breakds has quit [Remote host closed the connection]
zpe has quit [Ping timeout: 264 seconds]
shinnya has quit [Ping timeout: 276 seconds]
yezariaely has joined #ocaml
Guest76769 has joined #ocaml
zpe has joined #ocaml
wagle_ is now known as wagle
ygrek has quit [Ping timeout: 245 seconds]
zpe has quit [Ping timeout: 245 seconds]
Simn has joined #ocaml
Snark has joined #ocaml
Neros has quit [Ping timeout: 264 seconds]
<adrien>
pippijn: finalizers are called in an unspecified order? (actually, maybe not: maybe the first installed if they're all called in a batch and that should be fairly easy to check in the code even though I think this has been asked on the ML)
ggole has joined #ocaml
csakatok_ has joined #ocaml
csakatoku has quit [Ping timeout: 264 seconds]
skchrko has joined #ocaml
zpe has joined #ocaml
zpe has quit [Ping timeout: 256 seconds]
ihm1 has quit [Quit: ihm1]
ttamttam has joined #ocaml
pango has quit [Ping timeout: 260 seconds]
Neros has joined #ocaml
ygrek has joined #ocaml
chrisdotcode has quit [Ping timeout: 260 seconds]
Neros has quit [Ping timeout: 264 seconds]
zpe has joined #ocaml
djcoin has joined #ocaml
venk` has joined #ocaml
zpe has quit [Ping timeout: 276 seconds]
venk has quit [Ping timeout: 245 seconds]
Drup has joined #ocaml
zpe has joined #ocaml
zpe has quit [Read error: Connection reset by peer]
zpe has joined #ocaml
maufred has joined #ocaml
ontologiae has joined #ocaml
mika1 has joined #ocaml
vpm has quit [*.net *.split]
vpm has joined #ocaml
cago has joined #ocaml
Guest76769 has quit [Remote host closed the connection]
zpe has quit [Remote host closed the connection]
thomasga has joined #ocaml
Neros has joined #ocaml
Kakadu has joined #ocaml
* whitequark
feels guilty writing "Some meth", for "method"
* whitequark
has watched waaaay too much breaking bad
<Kakadu>
whitequark: :D
<jpdeplaix>
:D
AltGr has joined #ocaml
ben_zen has joined #ocaml
ben_zen has quit [Read error: Operation timed out]
<Kakadu>
okay, back to merlin
zpe has joined #ocaml
<Kakadu>
I want to write 'do' but it provides me autocomplete in that order: DOT,do,dot,done,downto
<Kakadu>
Is it reasonable to sort autocomplete strings
zpe has quit [Remote host closed the connection]
zpe has joined #ocaml
<Kakadu>
I want the top items to be more similiar to user input than bottom items
<Kakadu>
i.e. do,done,downto,DOT,dot
<Kakadu>
i.e. do,done,downto,dot,DOT
<Kakadu>
def-lkb, rks`, any comments?
<Drup>
or just disable auto complete for things shorter than 4/5 char, because it's just silly :p
<rks`>
Kakadu: :h completeopt
<rks`>
but Kakadu
<rks`>
I thought you were using emacs
<rks`>
wtf.
<Kakadu>
yes, I use emacs and talking about it
<rks`>
OH
<def-lkb>
Kakadu: merlin won't suggest you do, done or downto, those are keywords
<rks`>
(what he implies is : the completion you received probably aren't provided by merlin)
<Kakadu>
ah
<rks`>
(an easy way to be sure of that is : merlin will *always* give you the signature of the completion it suggests)
<rks`>
(if you don't see any signature, then merlin's not involved)
<Kakadu>
okay....
The_third_man has quit [Ping timeout: 260 seconds]
The_third_man has joined #ocaml
weie has quit [Quit: Leaving...]
ggole has quit [Ping timeout: 264 seconds]
weie has joined #ocaml
ggole has joined #ocaml
Neros has quit [Ping timeout: 264 seconds]
Neros has joined #ocaml
<whitequark>
does anyone else get spurious warnings with menhir?
<whitequark>
Warning 20: this argument will not be used by the function.
<whitequark>
when I do stuff like "x=func { (fun defs -> x defs) }"
<adrien_oww>
{ } and no field record name? I don't use menhir but that looks weird
<whitequark>
oh, {} is menhir syntax for production rules
q66 has joined #ocaml
darkf has quit [Quit: Leaving]
dsheets has quit [Ping timeout: 264 seconds]
Drup has quit [Ping timeout: 276 seconds]
dsheets has joined #ocaml
_5HT has joined #ocaml
ygrek has quit [Ping timeout: 264 seconds]
_andre has joined #ocaml
yacks has joined #ocaml
ben_zen has joined #ocaml
ollehar has joined #ocaml
talzeus has quit [Remote host closed the connection]
Drup has joined #ocaml
ollehar has quit [Ping timeout: 248 seconds]
ollehar has joined #ocaml
Drup has quit [Ping timeout: 248 seconds]
Neros_ has joined #ocaml
djcoin has quit [Quit: WeeChat 0.4.1]
Neros has quit [Ping timeout: 264 seconds]
csakatok_ has quit [Remote host closed the connection]
djcoin has joined #ocaml
shinnya has joined #ocaml
oriba has joined #ocaml
Drup has joined #ocaml
<rwmjones>
camlp4 .. so great yet so frustrating
<rwmjones>
anyone want to hazard a guess why this doesn't do what it obviously should do?
<rwmjones>
<:expr< fun () -> $expr$ >>
<rwmjones>
the expression it produces is printed as "(fun () -> [...])" and the compiler says the type is unit
<ggole>
Check the documentation.
<ggole>
Oh, wait.
* rwmjones
wishes there was a way to print the raw AST
<rwmjones>
ggole: :)
<rwmjones>
actually there is some documentation recently, but it's still terrible
<ggole>
You can fire up a repl and get camlp4 to produce the Ast
<rwmjones>
orly? do you know how?
<adrien_oww>
hmm, -ppx? :P
<ggole>
Um, let's see if I remember the incantation
<rwmjones>
what I'm doing is:
<rwmjones>
camlp4o ../../pa_goal.cmo pr_o.cmo compile.ml | less
beckerb has joined #ocaml
<rwmjones>
where compile.ml is my source being processed
<rwmjones>
and pa_goal is my parser
<rwmjones>
but that just prints out the regular syntax and I think there's some "hidden" node in the AST
<pippijn>
now, how can I do this without Obj.magic?
<pippijn>
actually it outputs: call say (hello, 300) : int
<pippijn>
(I had map instead of rev_map before)
<mrvn>
pippijn: I think you need to start from scratch. Google for a functional or cps printf implementation and adopt that.
<mrvn>
I can't fix this from memory, sorry.
<mrvn>
pippijn: I think your mix of arguments and return value in foreign can't work.
<pippijn>
mrvn: printf operates on its arguments directly
<pippijn>
ah
<pippijn>
too bad
<mrvn>
pippijn: a function printf would be for example 'printf (int $ float $ string) 1 1.0 "hello"'
<mrvn>
pippijn: maybe this works: Instead of putting "string sv" into the list put closures of the push function in it.
<pippijn>
hmm
<pippijn>
yes
Drup has quit [Ping timeout: 260 seconds]
<pippijn>
actually no
<pippijn>
mrvn: not useful, that's just as unsafe
<pippijn>
I'll try splitting argtypes and function
Neros has quit [Ping timeout: 245 seconds]
<pippijn>
Function (String, Function (Int, Returns (Int)))
<mrvn>
when you apply string to that you want to get back something like (sv_of_string str, Function (Int, Returns (Int))), right?
<pippijn>
hmm
<mrvn>
Then when you apply int you get ((sv_of_int int, sv_of_string str), Returns (Int)) and that you can then call perl.
<pippijn>
yes
<pippijn>
that sounds good
<mrvn>
So as you reduce the Function parts you need to build up a data part.
<pippijn>
yes
zpe has quit [Remote host closed the connection]
<mrvn>
something like ('a data * ('b -> 'c) fn) -> (('a * 'b) data * 'c fn)
<mrvn>
something like ('a data * ('b -> 'c) fn) -> 'b -> (('a * 'b) data * 'c fn)
<pippijn>
hm, right
<mrvn>
or ('a * ('b -> 'c) fn) -> 'b -> (('a * 'b) data * 'c)
<mrvn>
'c could be another fn or a result.
tom39341 has left #ocaml []
<mrvn>
problem is how to handle the last argument. Because when passing that you want to evaluate the whole thing and return the result.
Kakadu has quit []
dsheets has quit [Read error: Operation timed out]
<mrvn>
you can use some wrapper functions there. foreign recursively builds the functions that do the ('a data * ('b -> 'c) fn) -> 'b -> (('a * 'b) data * 'c fn) and then wrap it with a function that handles the perl call.
<mrvn>
pippijn: How do you plan to handle perl functions that can take different types?
<mrvn>
declare a foo_scalar and foo_array and so on?
<pippijn>
mrvn: yes
<pippijn>
or custom marshallers
<pippijn>
with variant types on the ocaml side
<mrvn>
I just had a thought: doesn't ctypes solve the same problem?
<pippijn>
yes, but ctypes solves a more difficult problem
<pippijn>
and it uses magic a lot to do that
<mrvn>
ok, never mind then. magic is bad. :)
<pippijn>
I want to solve this simpler problem in a type-safeway
<pippijn>
ctypes' "foreign" is something like "get function address from dll, magic it into the appropriate ocaml function"
<pippijn>
(or maybe I misunderstood)
<mrvn>
haven't used it myself
<pippijn>
me neither
<pippijn>
just looked at the code for inspiration
ygrek has quit [Ping timeout: 260 seconds]
Neros has joined #ocaml
<pippijn>
mrvn: for the wrapper thing to work, Returns should be at the top of the syntax tree?
<pippijn>
Function (args, Returns (Int))
<mrvn>
That's the bottom but yes.
Neros has quit [Remote host closed the connection]
<pippijn>
A (A (a, B), B)
<pippijn>
is a now at the top?
<mrvn>
no
<pippijn>
right
<mrvn>
and it would be F(a, F(b, R))
ollehar has joined #ocaml
<pippijn>
mrvn: ok, yes, so it should be at the bottom
Neros has joined #ocaml
ihm1 has quit [Quit: ihm1]
<ggole>
I'd like to print floats more or less as print_float does, except with integral floats printed as xxx.0 rather than xxx.
<ggole>
Is there something for that?
<mrvn>
# Printf.printf "%f" 10000.0;;
<mrvn>
10000.000000- : unit = ()
<mrvn>
do you want more or less 0es?
<mrvn>
# Printf.printf "%1.1f" 10000.0;;
<mrvn>
10000.0- : unit = ()
<ggole>
# printf "%1.1f" 1.1231231;;
<ggole>
1.1- : unit = ()
<ggole>
Not good.
<ggole>
Guess I'll just check for integral values and print the zero if necessary.
beckerb has quit [Ping timeout: 264 seconds]
<mrvn>
check if the last char in the string is .
<ggole>
The output is a stream, not a string.
<ggole>
I think if floor f = f then print_char '0' will do.
<ggole>
Probably breaks on large values or something.
<ggole>
But I'll cross that bridge when it collapses under me.
Drup has joined #ocaml
<ggole>
Right, doesn't do the right thing for infinity.
<ggole>
if floor f = f then printf "%.1f" f else print_float f
ollehar has quit [Quit: ollehar]
Arsenik has joined #ocaml
Xom has quit [Quit: ChatZilla 0.9.90.1 [Firefox 23.0.1/20130814063812]]
Arsenik has quit [Max SendQ exceeded]
Arsenik has joined #ocaml
tane has joined #ocaml
dsheets has joined #ocaml
Yang__ has quit [Read error: Connection timed out]
<Anarchos>
pippijn too many occurences of sp for different things in the same code : bad practice....
<pippijn>
ok
<mrvn>
pippijn: you can't because line 128 has no constructor
<whitequark>
oh gadts
<whitequark>
no idea sorry
thomasga has joined #ocaml
<whitequark>
I'm not very good with GADTs
<pippijn>
mrvn: ok, if it does (like before, with Returns/Function and type/fn split?
<pippijn>
Anarchos: 2 things
ulfdoz has quit [Ping timeout: 260 seconds]
<pippijn>
Anarchos: sp in a type and a value (which is of type sp)
<Anarchos>
pippijn and what does the ocaml toplevel says ?
<pippijn>
about what?
<mrvn>
pippijn: why do you have a gadt type in invoke?
<pippijn>
ah
<pippijn>
I guess it's not necessary there
<pippijn>
it's also not recursive
<mrvn>
it is, but you don't have a GADT type for your sp
<mrvn>
sp needs to be type b . b data
<pippijn>
what's data?
<mrvn>
the type you will use to store your data
<pippijn>
ok, I'll make a split between values and functions again
<mrvn>
and you don't need any GADTs for the way we discussed earlier
<pippijn>
what way is that?
<mrvn>
with building tuples with the data
<pippijn>
val foreign : string -> ('a -> 'b) fn -> 'a -> 'b
<pippijn>
this is possible with that way?
<mrvn>
should be
def-lkb has quit [Ping timeout: 240 seconds]
def-lkb has joined #ocaml
deavid has quit [Read error: Connection reset by peer]
GlenK has joined #ocaml
<GlenK>
hi there.
kerneis has quit [Ping timeout: 240 seconds]
deavid has joined #ocaml
kerneis has joined #ocaml
<mrvn>
how do you want to pass the arguments to perl anyway?
<GlenK>
so I'm trying to get opa going. ocaml is a dependency. got that going. but now I'm missing things like ocamlfind, camlzip, ocamlgraph, etc. is there something like ruby gems for ocaml? or did I not compile ocaml correctly perhaps?
<companion_cube>
you can use opam
<pippijn>
mrvn: doesn't really matter, but right now it's a list which is put into an array on the C side
<mrvn>
pippijn: I think it is the most important part. Start there and then work outwards.
<mrvn>
if you don't want reverse order then you need cps
<pippijn>
reverse order is fine
<pippijn>
this is what it is right now
<pippijn>
reverse order is very useful on the C side, as well
<pippijn>
but isn't this cps, anyway?
<pippijn>
ah no
<pippijn>
anyway, I know the type of "sp"
rwmjones has joined #ocaml
<pippijn>
it's like we discussed earlier: as more arguments are passed, the argument list "a fn" shrinks and the "sp" type grows
<pippijn>
19:05 <@mrvn> or ('a * ('b -> 'c) fn) -> 'b -> (('a * 'b) data * 'c)
<pippijn>
I can't fill this type with code
<mrvn>
pippijn: fir a fn shrinks and sp grows then you are doing the right thing
<pippijn>
yes, and it works, but I don't know how to type sp
<pippijn>
right now, sp is just 'a, some opaque type variable with no information, which gets magicked into an 'f sv list for the C call
<pippijn>
the type does grow, but unbeknownst to ocaml
derek_c has quit [Quit: leaving]
<mrvn>
pippijn: I still don't get why you wan't to pass concret 'f sv types to the C function. The function that creates the sv already converts the ocaml type to the perl type. So why not keep it abstract?
<rwmjones>
grrrr Str grrrrr
<rwmjones>
does this make sense to anyone?
<rwmjones>
# open Str;;
<rwmjones>
# let r = regexp "foo" ;;
<rwmjones>
val r : Str.regexp = <abstr>
<rwmjones>
# string_match r "barfoobar" 0 ;;
<rwmjones>
- : bool = false
<rwmjones>
# string_match r "foo" 0 ;;
<rwmjones>
- : bool = true
<rwmjones>
# let r = regexp ".*foo.*" ;;
<rwmjones>
val r : Str.regexp = <abstr>
<rwmjones>
# string_match r "barfoobar" 0 ;;
<rwmjones>
- : bool = true
<rwmjones>
# string_match r "foo" 0 ;;
<rwmjones>
- : bool = true
<rwmjones>
# string_match r "\nfoobar" 0 ;;
<rwmjones>
- : bool = false
<pippijn>
mrvn: I could keep it abstract, yes
zpe has joined #ocaml
<pippijn>
mrvn: I just thought it would be nice to do it this way
venk` has quit [Remote host closed the connection]
<pippijn>
so that to_sv and sv_to can be type-safe, as well
<mrvn>
pippijn: to_sv already is type save.
<pippijn>
val to_sv : 'a typ -> 'a -> 'a sv
<mrvn>
val to_sv : 'a typ -> 'a -> perl_value
<pippijn>
yes, but then perl_value is anything and can be converted to 'b
<pippijn>
by sv_to : 'b typ -> perl_value -> 'b
<pippijn>
I figured I could have the "unsafe" part in one place only
<pippijn>
on the boundary of C and perl
<pippijn>
eh
<pippijn>
C and ocaml
<mrvn>
If you must then that would be where GADT used as witness type come in. Or double box the perl value.
<pippijn>
I don't want to double box it, if it can be avoided
Yang__ has quit [Read error: Connection timed out]
Yang__ has joined #ocaml
<pippijn>
mrvn: what would the type for cps look like?
<mrvn>
val foreign : string -> 'a signature -> 'a
<pippijn>
signature is like fn?
<mrvn>
yes
<mrvn>
pippijn: It's not like the signature of foreign is going to change no matter how you implement it internally.
<pippijn>
yes, that's good
<mrvn>
The magic is going to be in the 'a signature or 'a fn and the function 'a you return.
<pippijn>
the problem with sp is that it grows, and I have no idea how to express that in ocaml types
<pippijn>
maybe it needs to carry along the original signature
<pippijn>
because I end up with: val foreign : 'final_sp -> string -> 'result fn -> 'result
<mrvn>
if you don't want magic then you need a GADT for the return type.
<pippijn>
hmm, for the return type?
<mrvn>
the result.
<mrvn>
so you can decode the perl data into ocaml types.
Neros has quit [Remote host closed the connection]
<pippijn>
but the result is already a GADT, isn't it?
<pippijn>
in Returns : 'a typ -> 'a fn
<mrvn>
is it? well, then you're set
<mrvn>
wrong kind though. I was thinking of a witness type.
<mrvn>
So that you can have externa call_perl : string -> ('a, 'b typ) signature -> 'a sp -> ('b typ, 'b sp) or something.
pkrnj has quit [Ping timeout: 248 seconds]
<pippijn>
ok, I'll make an sp type then
<mrvn>
You have the type of the return value from the signature but you only get a value of that type when you evalute the function.
<pippijn>
since apparently it's bad to have plain tuples for sp
* rwmjones
gives up and uses Pcre ..
osnr has quit [Ping timeout: 240 seconds]
osnr has joined #ocaml
zpe has quit [Remote host closed the connection]
Anarchos has quit [Quit: Vision[0.9.7-H-280704]: i've been blurred!]