<tehdeuce>
Would it be possible to write a function that takes a number as an input and then consumes that many arguments (ie, you could write consume 2 x y, and it would consume x and y and do nothing with them)?
<zmdkrbou>
nope
<zmdkrbou>
you couldn't give a type to this function
<zmdkrbou>
(that's why the type of printf is an ugly hack in ocaml)
<tehdeuce>
It wouldn't be possible even with -rectypes?
<tehdeuce>
Excuse my ignorance. I'm not completely sure how rectypes works
<zmdkrbou>
it's not a recursive type problem, no
noteventime has quit [Remote closed the connection]
<tehdeuce>
okay. Thanks for the help
benny has quit [Read error: 110 (Connection timed out)]
piggybox5 has joined #ocaml
piggybox has quit [Nick collision from services.]
jatqceer has joined #ocaml
jatqceer has left #ocaml []
tehdeuce has quit ["Leaving."]
yzx has joined #ocaml
yzx has left #ocaml []
kosmikus has quit [Remote closed the connection]
kosmikus has joined #ocaml
_blackdog has quit ["Ex-Chat"]
<psnively>
Hmmm. Seems like that should be doable with a polymorphic Y combinator.
seafoodX has joined #ocaml
psnively has quit []
Clintach_ has joined #ocaml
seafoodX has quit [heinlein.freenode.net irc.freenode.net]
kosmikus has quit [heinlein.freenode.net irc.freenode.net]
piggybox5 has quit [heinlein.freenode.net irc.freenode.net]
benny_ has quit [heinlein.freenode.net irc.freenode.net]
Foxyloxy has quit [heinlein.freenode.net irc.freenode.net]
slipstream-- has quit [heinlein.freenode.net irc.freenode.net]
vincenz has quit [heinlein.freenode.net irc.freenode.net]
vorago has quit [heinlein.freenode.net irc.freenode.net]
z__z has quit [heinlein.freenode.net irc.freenode.net]
vincenz has joined #ocaml
benny has joined #ocaml
z__z has joined #ocaml
slipstream has joined #ocaml
Foxyloxy has joined #ocaml
seafoodX has joined #ocaml
piggybox has joined #ocaml
kosmikus has joined #ocaml
piggybox5 has joined #ocaml
slipstream-- has joined #ocaml
vorago has joined #ocaml
kosmikus has quit [Success]
slipstream-- has quit [Connection reset by peer]
vorago has quit [Read error: 104 (Connection reset by peer)]
vorago has joined #ocaml
piggybox5 has quit [No route to host]
kosmikus has joined #ocaml
<lde>
type 'a f = 'a -> 'a f;;
<lde>
let rec f x :'a f = f;;
<lde>
Why does f 23 goes into an endless loop?
<flux>
I don't know, but it works if you don't run ocaml in -rectypes and use an explicity constructor instead
<lde>
flux: You mean something like type 'a f = F of ('a -> 'a f)?
<flux>
yes
<lde>
And how would I use it?
<lde>
let rec f x :'a f = (F f)?
<flux>
yes
<lde>
Without :'a f even.
<flux>
well, you can put the 'a f there if you want
<lde>
But in this case f x evaluates to F f
<lde>
Yes, i mean it's not needed now.
<lde>
Hm.
<lde>
I'd have to define another function taking (F f) as an argument.
<lde>
To use it in any way.
<lde>
Right?
<flux>
you could use let get_f (F f) = f to extract the function
<flux>
maybe someone on the caml mailing list could tell if that infinite loop is a bug or a feature
<lde>
Right, but i wanted to do f 1 2 3 4 ... (No, not for any particular reason ;-).
<flux>
perhaps you can't :)
<lde>
Oh well.
<lde>
Thanks.
<flux>
hm
<flux>
you could define something like let (++) (F f) n = f n
<flux>
but it wouldn't be the same, would it..
<flux>
but it would allow you to write f 42 ++ 44 ++ 64 etc.. perhaps you could pick a nicer operator
<lde>
Yes, that's pretty close. :-)
ygrek has joined #ocaml
jlouis has joined #ocaml
xavierbot has joined #ocaml
<rwmjones>
(object method m = "morning" end) # m;;
<xavierbot>
- : string = "morning"
Foxyloxy has quit ["Sausages!"]
<ygrek>
Sys.ocaml_version;;
<xavierbot>
Characters 1-18:
<xavierbot>
Sys.ocaml_version;;
<xavierbot>
^^^^^^^^^^^^^^^^^
<xavierbot>
Unbound value Sys.ocaml_version
<flux>
4;;3;;
<xavierbot>
- : int = 4
<flux>
let _ = ();;
<xavierbot>
- : unit = ()
<flux>
type 'a f = F of ('a -> 'a f) let rec f x = F f let (++) (F f) x = f x let _ = f 42 ++ 44 ++ 22;;
<xavierbot>
type 'a f = F of ('a -> 'a f)
<lde>
let rec f () = f () in f ();;
<xavierbot>
Characters 31-34:
<xavierbot>
Parse error: [binding] expected after [opt_rec] (in [str_item])
<xavierbot>
Characters 5-8:
<xavierbot>
Parse error: illegal begin of top_phrase
<lde>
hm
<lde>
while true do () done;;
<xavierbot>
Characters 9-10:
<xavierbot>
while true do () done;;
<xavierbot>
^
<xavierbot>
Unbound value f
<flux>
unbound value f, hm?-)
<lde>
true;;
<xavierbot>
Characters 1-5:
<xavierbot>
Parse error: [sequence] expected after "while" (in [expr])
<xavierbot>
true;;
<xavierbot>
^^^^
<flux>
let _ = while true do () done;;
<flux>
uh oh :)
jlouis_ has quit [Read error: 110 (Connection timed out)]
<lde>
23;;
<rwmjones>
the subprocess should die after 60 seconds of CPU, then restart
<rwmjones>
that's the theory anyway ...
<flux>
hmph
<flux>
60 seconds is a lot, imo
<flux>
5 seconds would be more suitable
<rwmjones>
yup
<rwmjones>
but remember that it's n seconds over the lifetime of the process
<xavierbot>
Objective Caml version 3.10.0
<xavierbot>
Camlp4 Parsing version 3.10.0
<flux>
heh, restart :)
<rwmjones>
worked as well, amazing :-)
<rwmjones>
print_endline "am I ok?";;
<xavierbot>
am I ok?
<xavierbot>
- : unit = ()
Clintach_ has quit [Read error: 113 (No route to host)]
<flux>
how about flood prevention?
<flux>
I'm not going to try that unless you say it has one :)
<rwmjones>
the IRC chan itself does that
<flux>
what?
<flux>
does it flood itself out of the ircnet?
<flux>
I was thinking more in the lines of "max 4 lines of output per query"
<xavierbot>
rwmjones: expr ;; evaluate expr in OCaml toplevel
<xavierbot>
rwmjones: help help message
<xavierbot>
rwmjones: restart restart the toplevel
clog has joined #ocaml
noteventime has joined #ocaml
david_koontz has quit ["Leaving"]
ramkrsna has joined #ocaml
piggybox has quit []
oxylin has joined #ocaml
velco has joined #ocaml
ayrnieu has joined #ocaml
love-pingoo has joined #ocaml
oxylin has quit ["Ex-Chat"]
<love-pingoo>
mmmm :\
<love-pingoo>
anybody knows a way of imlementing OrderedType with a "physical" (as in (==)) ordering
<love-pingoo>
?
<love-pingoo>
I'm trying to get rid of identifiers in some code, using physical equality of some record instead. But I have to hash over these things...
<love-pingoo>
I'm afraid this will backfire
<rwmjones>
what's OrderedType?
<zmdkrbou>
the module for keys in the Map.Make functor and so on
<rwmjones>
module StringSet = Map.Make (String);;
<xavierbot>
module StringSet :
<xavierbot>
sig
<xavierbot>
type key = String.t
<xavierbot>
type 'a t = 'a Map.Make(String).t
<xavierbot>
val empty : 'a t
<xavierbot>
val is_empty : 'a t -> bool
<xavierbot>
val add : key -> 'a -> 'a t -> 'a t
<xavierbot>
val find : key -> 'a t -> 'a
<xavierbot>
val remove : key -> 'a t -> 'a t
<xavierbot>
val mem : key -> 'a t -> bool
<xavierbot>
val iter : (key -> 'a -> unit) -> 'a t -> unit
<xavierbot>
val map : ('a -> 'b) -> 'a t -> 'b t
<xavierbot>
val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
<xavierbot>
val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
<xavierbot>
val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
<xavierbot>
val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
<xavierbot>
end
<rwmjones>
StringSet.keys;;
<xavierbot>
Characters 1-15:
<xavierbot>
StringSet.keys;;
<xavierbot>
^^^^^^^^^^^^^^
<xavierbot>
Unbound value StringSet.keys
<ppsmimou>
hum
<ppsmimou>
what if I type
<ppsmimou>
let () = while true do () done;;
<zmdkrbou>
you're so mean :)
<xavierbot>
Objective Caml version 3.10.0
<xavierbot>
Camlp4 Parsing version 3.10.0
slipstream-- has joined #ocaml
<zmdkrbou>
Sys.command "ls";;
<xavierbot>
Characters 0-11:
<xavierbot>
Sys.command "ls";;
<xavierbot>
^^^^^^^^^^^
<xavierbot>
Unbound value Sys.command
<zmdkrbou>
hehe
<love-pingoo>
this game has been played yesterday already
<ppsmimou>
zmdkrbou: tsss, I was thinking to try exactly the same thing
<love-pingoo>
though I didn't see the issue
<zmdkrbou>
ppsmimou: you h4x0rz
<ppsmimou>
;)
<love-pingoo>
how bad can it be to cast a record to an int using Obj.magic ? I've node idea :)
<zmdkrbou>
ergl
<ppsmimou>
ah new fun
<rwmjones>
like this?
<ppsmimou>
let () = (Obj.magic 0) ^ "x";;
<xavierbot>
Characters 11-20:
<xavierbot>
let () = (Obj.magic 0) ^ "x";;
<xavierbot>
^^^^^^^^^
<xavierbot>
Unbound value Obj.magic
<ppsmimou>
too bad
<bluestorm_>
love-pingoo: wouldn't Hahstbl.hash be better
<bluestorm_>
?
<rwmjones>
Hashtbl.hash;;
<xavierbot>
- : 'a -> int = <fun>
<ppsmimou>
rwmjones: what modules does your bot have ?
<rwmjones>
ppsmimou, most of them
<rwmjones>
I'll upload a new version of the source so you can all check
<flux>
did I mention something about flooding the channel?-)
<xavierbot>
val widen : table -> unit
<xavierbot>
val add_initializer : table -> (obj -> unit) -> unit
<love-pingoo>
bluestorm_: Hashtbl.hash is based on the structure of objects.. I want different hash values for physcially different objects if possible
<xavierbot>
val dummy_table : table
<xavierbot>
val create_table : string array -> table
<love-pingoo>
FLOOOOD
<xavierbot>
val init_class : table -> unit
<xavierbot>
val inherits :
<rwmjones>
that module is required to support objects, but it's contains lots of strange methods
<xavierbot>
table ->
<xavierbot>
string array ->
<xavierbot>
string array ->
<xavierbot>
string array ->
<ppsmimou>
rwmjones: feel free to kill it
<xavierbot>
t * (table -> obj -> Obj.t) * t * obj -> bool -> Obj.t array
<bluestorm_>
love-pingoo:
<xavierbot>
val make_class :
<xavierbot>
string array ->
<love-pingoo>
zmdkrbou: I lookup your function, but is it really different
slipstream-- has quit [Read error: 110 (Connection timed out)]
<zmdkrbou>
rwmjones: why is Printf disabled ?
<joshcryer>
gim, yeah, I noticed, I didn't write it, found it on Google, and you are supposed to run it as an .ml without the ;;.
<rwmjones>
zmdkrbou, because the Printf module has a bunch of weird, possibly unsafe stuff in it which I didn't have time to filter out, but I agree it shold be there
<rwmjones>
should
<gim>
motd;;
<xavierbot>
Characters 1-5:
<xavierbot>
motd;;
<xavierbot>
^^^^
<xavierbot>
Unbound value motd
<zmdkrbou>
it was restarted
<gim>
he fogot quickly about things :)
xavierbot has quit [Remote closed the connection]
xavierbot has joined #ocaml
<rwmjones>
module P = Printf;;
<xavierbot>
module P :
<xavierbot>
sig
<xavierbot>
val fprintf : out_channel -> ('a, out_channel, unit) format -> 'a
<xavierbot>
val printf : ('a, out_channel, unit) format -> 'a
<xavierbot>
val eprintf : ('a, out_channel, unit) format -> 'a
<xavierbot>
val ifprintf : 'a -> ('b, 'a, unit) format -> 'b
<xavierbot>
val sprintf : ('a, unit, string) format -> 'a
<xavierbot>
val bprintf : Buffer.t -> ('a, Buffer.t, unit) format -> 'a
xavierbot has quit [Remote closed the connection]
xavierbot has joined #ocaml
<rwmjones>
module P = Printf;;
<xavierbot>
module P :
<xavierbot>
sig
<xavierbot>
val printf : ('a, out_channel, unit) format -> 'a
<xavierbot>
val sprintf : ('a, unit, string) format -> 'a
<gim>
let walk = let i = ref 0 in fun () -> incr i; Printf.printf "%d kilometres a pieds, ca use les souliers\n" !i;;
<xavierbot>
val walk : unit -> unit = <fun>
<gim>
walk ();;
<xavierbot>
1 kilometres a pieds, ca use les souliers
<xavierbot>
- : unit = ()
<smimou>
walk ();;
<xavierbot>
2 kilometres a pieds, ca use les souliers
<xavierbot>
- : unit = ()
<fremo>
walk();;
<xavierbot>
3 kilometres a pieds, ca use les souliers
<xavierbot>
- : unit = ()
<fremo>
:)
<rwmjones>
walk();;
<xavierbot>
4 kilometres a pieds, ca use les souliers
<xavierbot>
- : unit = ()
<Lena>
gim, the international version is with "99 bottle of beer on the wall". By the way, french without accents isn't french:p
jaapweel has joined #ocaml
<gim>
i wasn't sure about the charset to use on this chan
<gim>
(and on this 104 keys keyboard i cant do a \`a, i usually map it on the missing key)
<smimou>
gim: dvorak wasn't meant to be really used
<gim>
you should try :p
TFK has joined #ocaml
cjeris has joined #ocaml
bluestorm_ has quit [Read error: 113 (No route to host)]
<TFK>
Howdy folks. If I have a function written in an imperative style, which is made of two parts - an inner part and an outer part - and the inner part uses some variables that are not used in the inner part, what is considered better practice: having all the function's variables defined in a single "let-in" or have a separate "let-in" for the inner part?
robyonrails has joined #ocaml
slipstream has quit [Read error: 110 (Connection timed out)]
<rwmjones>
TFK, got some code we can see?
<ygrek>
" and the inner part uses some variables that are not used in the inner part" :)
<jatqceer>
Hi, if initially a scanning buf holds "123 456", what would it change to after I do a bscanf with format "%f" on it?
<TFK>
ygrek, oops ^_^;; well, second "inner" should be "outer", of course.
<TFK>
rwmjones, on another computer 70 kms away :-(
<TFK>
It's basically a big C main() function I'm translating into OCaml and couldn't find a way to improve yet.
<jatqceer>
The Str.split approach to read my data is too slow. I would consider some faster way, but the format used by bscanf doesn't work well if I don't know how many it's going scan
<ygrek>
TFK, from my humble point of view it is better to create binding only when you need it...
pango has quit [Remote closed the connection]
slipstream has joined #ocaml
sgillespie has quit [Remote closed the connection]
* TFK
nods
robyonrails has quit []
<rwmjones>
jatqceer, if performance is a premium, write a manual scanner or use ocamllex
<jatqceer>
I'm just wondering if there is a faster solution
<jatqceer>
rwmjones: how does a scanning buffer work? It becomes empty after I do one scanf?
pango has joined #ocaml
<jatqceer>
let s = "123 456";;
<xavierbot>
val s : string = "123 456"
<jatqceer>
let b = Scanf.Scanning.from_string s;;
<xavierbot>
Characters 9-35:
<xavierbot>
let b = Scanf.Scanning.from_string s;;
<xavierbot>
^^^^^^^^^^^^^^^^^^^^^^^^^^
<xavierbot>
Unbound value Scanf.Scanning.from_string
<rwmjones>
jatqceer, no Scanf module
<jatqceer>
i see
slipstream has quit [Read error: 104 (Connection reset by peer)]
michel has joined #ocaml
sgillespie has joined #ocaml
oxylin has quit ["Ex-Chat"]
jatqceer has left #ocaml []
seafoodX has quit []
Lena has quit [anthony.freenode.net irc.freenode.net]
michel_ has joined #ocaml
michel has quit [Read error: 110 (Connection timed out)]
pango has quit [Remote closed the connection]
pango has joined #ocaml
mrpingoo has joined #ocaml
Mr_Awesome has joined #ocaml
ZabaQ has quit [Remote closed the connection]
qwwqe has quit [Remote closed the connection]
qwwqe has joined #ocaml
jaapweel has quit [Read error: 110 (Connection timed out)]
david_koontz has joined #ocaml
screwt8 has quit [Remote closed the connection]
screwt8 has joined #ocaml
bluestorm has joined #ocaml
joshcryer has quit [Read error: 104 (Connection reset by peer)]
mbishop has quit [Read error: 113 (No route to host)]
xavierbot has quit [Remote closed the connection]
xavierbot has joined #ocaml
<rwmjones>
let s = "123 456";;
<xavierbot>
val s : string = "123 456"
<rwmjones>
let b = Scanf.Scanning.from_string s;;
<xavierbot>
val b : Scanf.Scanning.scanbuf = <abstr>
slipstream has joined #ocaml
xavierbot has quit [Remote closed the connection]
xavierbot has joined #ocaml
<rwmjones>
xavierbot, help
<xavierbot>
hello rwmjones, I am xavierbot, an OCaml toplevel
<xavierbot>
rwmjones: expr ;; evaluate expr in OCaml toplevel
<xavierbot>
rwmjones: help help message
<xavierbot>
rwmjones: restart restart the toplevel
Submarine has joined #ocaml
<Mr_Awesome>
is this thing new?
<rwmjones>
Mr_Awesome, I wrote it yesterday, with help from LeCamarade
<Mr_Awesome>
awesome :)
<rwmjones>
it's for teaching newbies on this channel, so they can interactively try out statements
<Mr_Awesome>
every language channel should have an interpreter bot
<rwmjones>
let h = Hashtbl.create 13;;
<xavierbot>
val h : ('_a, '_b) Hashtbl.t = <abstr>
<rwmjones>
Hashtbl.add h 1 "one";;
<xavierbot>
- : unit = ()
<rwmjones>
Hashtbl.add h 2 "two";;
<xavierbot>
- : unit = ()
<rwmjones>
Hashtbl.add h 3 "three";;
<xavierbot>
- : unit = ()
<rwmjones>
Hashtbl.find h 1;;
<xavierbot>
- : string = "one"
<rwmjones>
Hashtbl.find h 4;;
<xavierbot>
Exception: Not_found.
<Mr_Awesome>
let s = =;;
<xavierbot>
let s = =;;
<xavierbot>
^
<xavierbot>
Characters 9-10:
<xavierbot>
Parse error: [fun_binding] expected after [a_LIDENT] (in [let_binding])
<Mr_Awesome>
let s = =
<Mr_Awesome>
hello everyone;;
<xavierbot>
Characters 1-6:
<xavierbot>
hello everyone;;
<xavierbot>
^^^^^
<xavierbot>
Unbound value hello
<rwmjones>
you have to put ';;' after your statement
<Mr_Awesome>
so the ;; marks input to the bot
<Mr_Awesome>
clever :)
<rwmjones>
yup, single line only too
<michel_>
exception Hello;;
<xavierbot>
exception Hello
joshcryer has joined #ocaml
<rwmjones>
raise Hello;;
<xavierbot>
Exception: Hello.
<Mr_Awesome>
Hello;;
<xavierbot>
- : exn = Hello
<michel_>
(Obj.magic 3)^"hello";;
<xavierbot>
Characters 2-11:
<xavierbot>
(Obj.magic 3)^"hello";;
<xavierbot>
^^^^^^^^^
<xavierbot>
Unbound value Obj.magic
<michel_>
grml
<rwmjones>
there is a way to crash it ...
<michel_>
a loop ?
<Mr_Awesome>
print_string "hi";;
<xavierbot>
hi- : unit = ()
<Mr_Awesome>
print_string "hi\n";;
<xavierbot>
hi
<xavierbot>
- : unit = ()
<Mr_Awesome>
yeah i was about to put it into an infinite loop :)
<rwmjones>
(object val virtual c : float method m = c end) # m;;
<xavierbot>
Objective Caml version 3.10.0
<xavierbot>
Camlp4 Parsing version 3.10.0
<rwmjones>
that's a compiler bug that Jon Harrop found yesterday
<rwmjones>
it causes the toplevel to segfault
<rwmjones>
it should auto-restart after segfaults
<Mr_Awesome>
xavierbot: restart
<xavierbot>
Objective Caml version 3.10.0
<xavierbot>
Camlp4 Parsing version 3.10.0
<Mr_Awesome>
i see
<Mr_Awesome>
what about infinite loops?
<rwmjones>
it will restart after 60 seconds of CPU time
<rwmjones>
and it will only send 16 lines to the channel to avoid floods
<rwmjones>
example:
<Mr_Awesome>
while true do print_string "hi" done;;
<rwmjones>
let rec loop () = loop () ;;
<rwmjones>
(that'll restart in now + 60 secs)
<Mr_Awesome>
why didnt it print 60 secs worth of strings?
<rwmjones>
I didn't tell it to print anything
<Mr_Awesome>
i did
<michel_>
the missing \n ?
<rwmjones>
Mr_Awesome, I didn't see your message so perhaps it got eaten somewhere
<Mr_Awesome>
hmm
<Mr_Awesome>
2 + 2;;
xavierbot has quit [Remote closed the connection]
xavierbot has joined #ocaml
<Mr_Awesome>
get ready to quit him
<Mr_Awesome>
while true do print_string "hi" done;;
<Mr_Awesome>
2 + 2;;
<Mr_Awesome>
:(
xavierbot has quit [Remote closed the connection]
xavierbot has joined #ocaml
<Mr_Awesome>
maybe you should set the timeout to 10 secs
<rwmjones>
it got chucked out of the channel for flooding, I think because of the lack of "\n" so it technically didn't print 16 "lines"
<Mr_Awesome>
while true do print_string "hi\n" done;;
<xavierbot>
hi
<xavierbot>
hi
<xavierbot>
hi
<xavierbot>
hi
<xavierbot>
hi
<xavierbot>
hi
<xavierbot>
hi
<Mr_Awesome>
ah i see
<xavierbot>
hi
<xavierbot>
hi
<xavierbot>
hi
<xavierbot>
hi
<xavierbot>
hi
xavierbot has quit [Remote closed the connection]
xavierbot has joined #ocaml
<rwmjones>
DoS attacks aren't much interest to me unless they DoS _my_ machine
<rwmjones>
if people flood it out of the channel, well that's their loss
<rwmjones>
I'm also more interested in potential exploits
<Mr_Awesome>
let rec loop () = loop ();;
<xavierbot>
val loop : unit -> 'a = <fun>
<Mr_Awesome>
shall i?
<rwmjones>
loop ();;
<rwmjones>
should restart in 10s
<xavierbot>
Objective Caml version 3.10.0
<xavierbot>
Camlp4 Parsing version 3.10.0
<Mr_Awesome>
nice :)
<michel_>
exception A of _;;
<xavierbot>
Characters 15-16:
<xavierbot>
exception A of _;;
<xavierbot>
^
<xavierbot>
Unbound type parameter _
<rwmjones>
ignore (String.make 100_000_000 ' ');;
<xavierbot>
Out of memory during evaluation.
<rwmjones>
ignore (String.make 32_000_000 ' ');;
<xavierbot>
Out of memory during evaluation.
<michel_>
oh, it doesn't work in 3.10 :'(
<rwmjones>
ignore (String.make 16_000_000 ' ');;
<xavierbot>
Out of memory during evaluation.
<rwmjones>
ignore (String.make 8_000_000 ' ');;
<xavierbot>
Out of memory during evaluation.
<rwmjones>
ignore (String.make 1_000_000 ' ');;
<xavierbot>
- : unit = ()
<Mr_Awesome>
ignore (String.make 4_000_000) ' ';;
<xavierbot>
Characters 1-7:
<xavierbot>
ignore (String.make 4_000_000) ' ';;
<xavierbot>
^^^^^^
<xavierbot>
This function is applied to too many arguments,
<xavierbot>
maybe you forgot a `;'
<rwmjones>
for i = 0 to 100 do ignore (String.make 1_000_000 ' ') done ;;
<xavierbot>
Out of memory during evaluation.
<rwmjones>
for i = 0 to 50 do ignore (String.make 1_000_000 ' ') done ;;
<xavierbot>
Out of memory during evaluation.
<Mr_Awesome>
ignore (String.make 4_000_000);;
<xavierbot>
Characters 21-30:
<xavierbot>
Warning F: this function application is partial,
<xavierbot>
maybe some arguments are missing.
<xavierbot>
ignore (String.make 4_000_000);;
<xavierbot>
^^^^^^^^^
<Mr_Awesome>
ignore (String.make 4_000_000 ' ');;
<xavierbot>
- : unit = ()
<xavierbot>
Out of memory during evaluation.
<Mr_Awesome>
ignore (String.make 2_000_000 ' ');;
<xavierbot>
Out of memory during evaluation.
<Mr_Awesome>
ignore (String.make 1_000_001 ' ');;
<xavierbot>
Out of memory during evaluation.
<Mr_Awesome>
ignore (String.make 1_000_000 ' ');;
<xavierbot>
Out of memory during evaluation.
<rwmjones>
strange that it's not GCing those
<rwmjones>
xavierbot, restart
<xavierbot>
Objective Caml version 3.10.0
<xavierbot>
Camlp4 Parsing version 3.10.0
<rwmjones>
for i = 0 to 50 do ignore (String.make 1_000_000 ' ') done ;;
<xavierbot>
Out of memory during evaluation.
<rwmjones>
xavierbot, restart
<xavierbot>
Objective Caml version 3.10.0
<xavierbot>
Camlp4 Parsing version 3.10.0
<Mr_Awesome>
ignore (String.make 1_000_000 ' ');;
<xavierbot>
- : unit = ()
<Mr_Awesome>
ignore (String.make 1_000_000 ' ');;
<xavierbot>
- : unit = ()
<Mr_Awesome>
ignore (String.make 1_000_000 ' ');;
<xavierbot>
- : unit = ()
<Mr_Awesome>
ignore (String.make 1_000_000 ' ');;
<xavierbot>
- : unit = ()
<Mr_Awesome>
ignore (String.make 1_000_000 ' ');;
<xavierbot>
- : unit = ()
<Mr_Awesome>
ignore (String.make 1_000_000 ' ');;
<xavierbot>
- : unit = ()
<Mr_Awesome>
ignore (String.make 4_000_000 ' ');;
<xavierbot>
Out of memory during evaluation.
<Mr_Awesome>
ignore (String.make 2_000_000 ' ');;
<xavierbot>
- : unit = ()
<Mr_Awesome>
ignore (String.make 3_000_000 ' ');;
<xavierbot>
Out of memory during evaluation.
<Mr_Awesome>
ignore (String.make 2_500_000 ' ');;
<xavierbot>
Out of memory during evaluation.
<Mr_Awesome>
ignore (String.make 2_250_000 ' ');;
<xavierbot>
Out of memory during evaluation.
<Mr_Awesome>
ignore (String.make 2_125_000 ' ');;
<xavierbot>
Out of memory during evaluation.
<rwmjones>
the memory ulimit is like 32MB, so I've no idea where the 2.125Mchar limit is coming from
<Mr_Awesome>
ignore (String.make 2_062_500 ' ');;
<xavierbot>
Out of memory during evaluation.
<Mr_Awesome>
ignore (String.make 2_031_250 ' ');;
<xavierbot>
Out of memory during evaluation.
<Mr_Awesome>
ignore (String.make 2_000_100 ' ');;
<xavierbot>
Out of memory during evaluation.
<Mr_Awesome>
ignore (String.make 2_000_001 ' ');;
<xavierbot>
Out of memory during evaluation.
<Mr_Awesome>
xavierbot: restart
<xavierbot>
Objective Caml version 3.10.0
<xavierbot>
Camlp4 Parsing version 3.10.0
<Mr_Awesome>
ignore (String.make 2_000_001 ' ');;
<xavierbot>
- : unit = ()
<Mr_Awesome>
hmm
<rwmjones>
odd
<Mr_Awesome>
xavierbot: restart
<xavierbot>
Objective Caml version 3.10.0
<xavierbot>
Camlp4 Parsing version 3.10.0
* rwmjones
should expose some Gc functions maybe
<Mr_Awesome>
ignore (String.make 8_000_000 ' ');;
<xavierbot>
Out of memory during evaluation.
<Mr_Awesome>
xavierbot: restart
<xavierbot>
Objective Caml version 3.10.0
<xavierbot>
Camlp4 Parsing version 3.10.0
<Mr_Awesome>
ignore (String.make 6_000_000 ' ');;
<xavierbot>
Out of memory during evaluation.
<Mr_Awesome>
xavierbot: restart
<xavierbot>
Objective Caml version 3.10.0
<xavierbot>
Camlp4 Parsing version 3.10.0
<Mr_Awesome>
ignore (String.make 4_000_000 ' ');;
<xavierbot>
- : unit = ()
<Mr_Awesome>
ignore (String.make 4_000_000 ' ');;
<xavierbot>
Out of memory during evaluation.
<Mr_Awesome>
yeah theres something wrong with GC
<Mr_Awesome>
if you restarted it every once in awhile no one would ever notice though ;)
pi-meson has joined #ocaml
<vincenz>
SPAM
fluctus has quit [Remote closed the connection]
qwwqe has quit ["Leaving"]
USACE1 has joined #ocaml
Clintach has joined #ocaml
<pi-meson>
is it possible to print an arbitrary ocamlgraph graph using graphviz?
mbishop has joined #ocaml
jlouis has quit ["network restructuring"]
ygrek has quit [Remote closed the connection]
jlouis has joined #ocaml
xavierbot has quit [Remote closed the connection]
Aphelion has joined #ocaml
Aphelion has quit [Client Quit]
psnively has joined #ocaml
xavierbot has joined #ocaml
<rwmjones>
pi-meson, you know there's a Graphviz module in ocamlgraph? Never used ocamlgraph myself, but Google search turned up a reference to it.