<adrien>
Daniel de Rauglaudre (ddr) is, but he's the author of camlp5 too
accel has joined #ocaml
<accel>
does ocaml provide anything like eval? if not, is it possible for a currently running ocaml process to _dynamically_, without quitting down + restarting, to load new ocaml code on the fly?
ccasin has quit [Quit: Leaving]
<accel>
can ocaml reload code on the fly?
<thelema_>
accel: it's sort of possible to compile and run code, but the interfaces for doing that aren't particularly accessible
<accel>
so I can't tell an ocmal program: "go read foo.ml; and call function bar in foo.ml" ?
<thelema_>
accel: that code can't interact with the rest of the system except in pretty limited ways
<thelema_>
you can compile foo, and dynlink the compiled module in
<accel>
how limited? as in they're in separate processes?
<thelema_>
I forget the typing restrictions, something like that new code can push data into an existing data structure, including functions...
<thelema_>
yes, that dynlink
<thelema_>
yup, the restrictions in Dynlink.loadfile explain what's up
accel has quit [Quit: leaving]
BiDOrD has quit [Ping timeout: 240 seconds]
kani has quit [Remote host closed the connection]
thatch has joined #ocaml
mfp has quit [Ping timeout: 264 seconds]
accel has joined #ocaml
mfp has joined #ocaml
oriba has quit [Remote host closed the connection]
myu2 has quit [Remote host closed the connection]
drunK has quit [Remote host closed the connection]
accel has quit [Quit: leaving]
Amorphous has quit [Ping timeout: 272 seconds]
Amorphous has joined #ocaml
quantumelixir has quit [Ping timeout: 240 seconds]
alexyk has joined #ocaml
<alexyk>
is there a pervasive to swallow a first argument? I need a lambda: fun _ x -> fst x; if there's my pervasive swallow_first, I'd say swallow_first |- fst (in Batteries)
eye-scuzzy has quit [Read error: Operation timed out]
alexyk has quit [Quit: alexyk]
accel has joined #ocaml
<accel>
in ocaml; what is the single ";" used for?
mbac has quit [Remote host closed the connection]
Edward_ has quit []
<accel>
why is indexing a string .[] rather than [] ?
<accel>
whdy does ocaml not have "where" like haskell ?
<accel>
is a "function" just a 1 arg "fun" that starts with a match _ with ?
alexyk has joined #ocaml
<mrvn_>
accel: sequenzes, e.g. in lists or arrays, probably simpler to parse, it has when, yes.
alexyk has quit [Read error: Connection reset by peer]
<accel>
isthis true:
<accel>
tuples can be elements of different type, but must be of constant size
<accel>
arrays can only contain one type, but of arbitrary sie
<accel>
*size*
<accel>
s/arrays/lists
alexyk has joined #ocaml
myu2 has joined #ocaml
LeNsTR has quit [Quit: LeNsTR]
ulfdoz has joined #ocaml
<mrvn_>
accel: arrays can be arbitrary size but can't change size. Lists are just a type 'a my_list = Nil | Cons of 'a * 'a my_list
alexyk has quit [Read error: Connection reset by peer]
<mrvn_>
Either the empty list or a tuple of one element and the rest of the list.
<mrvn_>
So yes, lists can be arbitrary size.
<accel>
got it, so array = std::vector (minus push_back and resize); list = singly linked list
<accel>
i.e. we can only push to front
<mrvn_>
arrays are more like plain int x[17];
mrvn_ is now known as mrvn
<accel>
okay
<accel>
I can accept that
<mrvn>
resize of std::vector may copy the vector though. So that would be like creating a new array and copying the old contents in ocaml.
thatch has quit [Remote host closed the connection]
fabjan has joined #ocaml
decaf has quit [Quit: Leaving.]
smerz has quit [*.net *.split]
maurer_ has quit [*.net *.split]
hcarty has quit [*.net *.split]
bacam has quit [*.net *.split]
willb1 has quit [*.net *.split]
ymasory_ has quit [*.net *.split]
dgfitch has quit [*.net *.split]
infoe has quit [*.net *.split]
fraggle_ has quit [*.net *.split]
duper has quit [*.net *.split]
myu2 has quit [*.net *.split]
rwmjones has quit [*.net *.split]
thomasga has quit [*.net *.split]
ulfdoz has quit [*.net *.split]
ftrvxmtrx has quit [*.net *.split]
Derander has quit [*.net *.split]
robthebob has quit [*.net *.split]
groves has quit [*.net *.split]
joewilliams has quit [*.net *.split]
hto has quit [*.net *.split]
gildor has quit [*.net *.split]
asmanur has quit [*.net *.split]
f[x] has quit [*.net *.split]
rudi_s has quit [*.net *.split]
Axioplase_ has quit [*.net *.split]
kerneis has quit [*.net *.split]
Obfuscate has quit [*.net *.split]
adrien has quit [*.net *.split]
mikemc has quit [*.net *.split]
mattam has quit [*.net *.split]
explodus has quit [*.net *.split]
haelix has quit [*.net *.split]
nimred has quit [*.net *.split]
emias has quit [*.net *.split]
mikemc has joined #ocaml
Obfuscate has joined #ocaml
<flux>
iirc extlib/batteries has an implementation of dynamic arrays
almaisan-away is now known as al-maisan
accel has quit [Ping timeout: 240 seconds]
al-maisan is now known as almaisan-away
almaisan-away is now known as al-maisan
<mrvn>
flux: ropes?
<mrvn>
The problem with dynamic arrays is that Array.get either looses the O(1) speed or the dynamic properties cost O(n). Which means it is just a nice wrapper around copying the array.
<flux>
mrvn, well, just being a nice wrapper is great
<flux>
mrvn, because you can easily allocate more space than you actually use
<flux>
mrvn, I think actually that Dynarray might use Obj.magic to pull that off
<mrvn>
flux: what for? The type of the value doesn't change when you resize an array.
<flux>
(and if you double the container size every time you need more space, the operation is amortized O(1) complexity)
<flux>
mrvn, I'm talking having a container that works more or less like std::vector
<mrvn>
still, as long as the size isn't part of the type the type doesn't change.
<flux>
which knows its actual size and the size it has allocated
<flux>
not sure where the type of the container came into this discussion?-)
<mrvn>
flux: Like Buffer.t except not for just chars.
<flux>
yes
<mrvn>
flux: it came with Obj.magic.
<flux>
and probably supports nicer operations
<flux>
mrvn, it is only needed if the container cannot use a default value for the un-used elements
<mrvn>
flux: ahh, yes. that makes sense.
<mrvn>
so you have to fill with Obj.magic 0 so the unused parts are initialized for the GC.
<flux>
yep
<flux>
batteries' BatDynArray appears to use Obj.magic
<flux>
I guess for that purpose
<flux>
but it uses Obj.new_block and other functions as well
<mrvn>
if you think about it then it becomes clear that it has to. Or you would have to supply a dummy element for the unused parts.
<flux>
but maybe that library works, its first copyright message is from 2003 and last from 2008..
<flux>
pretty nice module if you need one. I wonder how the performance is compared to regular arrays.
<mrvn>
The bad part of dynamic arrays is that in interactive programs you get hickups when they need to copy the array.
<flux>
"The bad part of gc is that in interactive programs you get hickups when they neet to do the gc." ;-)
<flux>
you would need to have a very large array to notice that
<mrvn>
flux: nah, that one does a little work every now and then. That is more a stutter than one hickup.
ttamttam has joined #ocaml
ttamttam has quit [Remote host closed the connection]
edwin has joined #ocaml
jlenormand has joined #ocaml
al-maisan is now known as almaisan-away
<jlenormand>
hey guys
<jlenormand>
I'd like to write a function which takes an int (say n), and returns a function (fun x_1 ... x_n -> [x_1;...;x_n])
<jlenormand>
(probably using tons of magic)
almaisan-away is now known as al-maisan
accel has joined #ocaml
ttamttam has joined #ocaml
Axioplase_ has joined #ocaml
rudi_s has joined #ocaml
f[x] has joined #ocaml
asmanur has joined #ocaml
gildor has joined #ocaml
explodus has joined #ocaml
thomasga has joined #ocaml
rwmjones has joined #ocaml
myu2 has joined #ocaml
smerz has joined #ocaml
willb1 has joined #ocaml
maurer_ has joined #ocaml
ymasory_ has joined #ocaml
bacam has joined #ocaml
hcarty has joined #ocaml
dgfitch has joined #ocaml
infoe has joined #ocaml
kerneis has joined #ocaml
fraggle_ has joined #ocaml
Derander has joined #ocaml
duper has joined #ocaml
adrien has joined #ocaml
mattam has joined #ocaml
haelix has joined #ocaml
robthebob has joined #ocaml
nimred has joined #ocaml
groves has joined #ocaml
joewilliams has joined #ocaml
emias has joined #ocaml
accel is now known as Guest91800
<f[x]>
accel, no, it is called generic print and it requires keeping type info at runtime which ocaml avoids
<accel>
and Ican't figure out: what problem does open unon types solve?
<mrvn>
accel: let bar = function `One -> "One" | `Two -> "Two" | _ -> "unknown";; ?
<mrvn>
# bar `Three;;
<mrvn>
- : string = "unknown"
<accel>
let me try this out
<mrvn>
You can write types that can be extended by others.
<accel>
you're not extending it
<accel>
it was all defined above
<mrvn>
true. but you can.
<accel>
so, above you used a match
<accel>
that's what cuases the "unknown"
<accel>
can you show me how I "extend" this?
<accel>
I can't see what I can do with union types that I can't do without them
<mrvn>
type foo = [ `One | `Two ] type bar = [ `One | `Two | `Three ]
<accel>
okay, just did that
<flux>
in practical level it 'solves' the problem of defining types
<flux>
but there are other applications as well
<accel>
gah
<accel>
how does "Open Union Types" differ from standard union / variants ?
<accel>
I don't see the difference
<accel>
not even on a syntactical level
<mrvn>
One application is for phantom types. You define `Read and `Write and use them if the type is readable or writable. Then you can specify functions that only need readable or that require writable.
<flux>
accel, how about this: let a x = match x with `Foo -> 1 let b x = match x with `Bar -> 0 | other -> a other
<flux>
you might not realize it at first, but the compiler doesn't say that the match in function a doesn't handle all cases
<flux>
because it actually does
<flux>
hmm, perhaps it wasn't a great example because it doesn't compile ;)
<accel>
Error: This expression has type [> `Bar ] but an expression was expected of type [< `Foo ] The second variant type does not allow tag(s) `Bar
<accel>
yeah
<accel>
flux --
<accel>
lol; only on IRC, do you people not appreciate you for trying to help them :-)
<accel>
is this true: open union types doen't do anthign new
<accel>
it just has a "catch all" that handles yet unkonwn types
<accel>
so, if I have a function f, that has a _ -> ....
<accel>
then I can have a function g, which handles one type, then do _ -> f _ ;
<accel>
so we end up 'chaining' the matches; is that what it's about?
<flux>
about right. but they are convenient tools for special circumstances as well, for example for phantom typing.
<accel>
maybe I'll understand that in a few days
<accel>
phantom types sounds like you're trying to sell me a dog with wings
<flux>
it allows to implement something like 'const' attribute in c++ in ocaml
<f[x]>
open unions are not required for phantom typing
<flux>
(and not just const, but other attributes as well)
<flux>
f[x], no they are not, but they are convenient
<flux>
f[x], if you have a set of attributes
<accel>
whoa
<accel>
c++ const is a "library" rather than a language feature?
<accel>
interesting
<mrvn>
# type foo = One | Two let foo = function One -> "one" | Two -> "two" type bar = One | Two | Three let s = foo One;;
<mrvn>
Error: This expression has type bar but an expression was expected of type foo
<f[x]>
the real benefit is that they allow to extend types, as mentioned above
<mrvn>
Without the open union you can't extend the type or call the old function with the new type.
<accel>
i can have functions & types of the same name?
<mrvn>
accel: sure
<accel>
mrvn: where are we extending the type?
<accel>
I see two separate tyeps
<accel>
foo = One | Two bar = One | Two | three ;
<accel>
I dont see any extending going on
<accel>
sorry if this soudns pedantic
<mrvn>
accel: because bar isn't an extension of foo. It shadows it completly.
<mrvn>
you can't without the [ `... ]
<accel>
bar is a separate type from foo
<accel>
mrvn: you didn't use a [ `... ]
<mrvn>
yes, that was the point.
<accel>
ah, is the point we can now deine a function
<accel>
that says `One ->
<accel>
rather than `Foo_one -> ... ; `Bar_one -> ... ;
<mrvn>
accel: one of the points.
<thomasga>
accel: if you write type foo = One | Two;; type bar = One | Two | Three;; then Two is of type bar
<flux>
I'm pretty sure accel doesn't want to use polymorphic variants, they have some runtime costs ;)
<accel>
flux: not everything I do involves cracking crypto
<thomasga>
with polymorphic variants, `Two is of type bar AND foo
<mrvn>
I'm assuming he is just learning what ocaml can do.
<accel>
NSA: I'm kidding; i do fluid simulations, not crypto
<mrvn>
accel: I'm not doing crypto, I'm just computing the shortest way from home to work and back (traveling salesman).
<f[x]>
stop saying nonsense about runtime costs until you measure it
<mrvn>
It isn't my fault the shortest way comes out as the digital signature of the president. *duck*
_andre has joined #ocaml
<mrvn>
polymorphic variants need more memory, right?
<accel>
f[x]: yesterday was about: "does ocaml seem worth learning; i.e. it has the potential to be fast"
<accel>
now is actually learning it
<mrvn>
accel: For me the far more important features are ease of writing and correctness of the code.
<f[x]>
why?
<f[x]>
Obj.is_int (Obj.repr `QQQ);
<accel>
f[x]: who are ou asking?
<mrvn>
f[x]: because `Foo of int is 3 words while Foo of int are 2.
<mrvn>
Foo encodes the "Foo" part in the tag of the block afaik.
<accel>
does that mean I can't have more than 2^31 types in ocaml?
<f[x]>
ah, yes for structured blocks
<mrvn>
accel: no, just not one type with more than 250 variants or so without it getting more expensive.
<mrvn>
accel: type foo = Foo and type bar = Bar will be encoded in memory both as just 0. The compiler knows they are different types. The runtime does not and doesn't need to.
avsm has joined #ocaml
<adrien>
mrvn: you've been using fuse, right? what are your thoughts on its perf? and if ps shows ntfs-3g as taking 100% cpu, do you think it could be caused by fuse and not ntfs-3g itself?
<accel>
fuse-ssh is amazing
<adrien>
ntfs-3g is amaring...ly slow
<adrien>
amazing*
<mrvn>
adrien: fuse recently has added support for splice. With that you can truely do 0 copies of the data. But the ntfs-3g is still using the old copying interface. So some blame goes to fuse for some memcpy(). Some to ntfs-3g. And some cpu load simply is. A filesystem is a complex thing.
<mrvn>
adrien: ntfs-3g on a loopbackfile on tmpfs has clocked over 900MB/s.
<adrien>
mrvn: it's down to 1MB/s write speed for me, perf is awful, on at least two computers, I'll spend more time profiling it but I'm trying to backup my data first (600GB to copy) and http://www.tuxera.com/products/tuxera-ntfs-commercial/performance/ shows far worse performance for their non-commercial edition
<mrvn>
adrien: What you can blame on fuse is that trivial operations like stat() take longer.
ikaros has joined #ocaml
<adrien>
I'm writing to _one_ the partition may be fragmented but there's still 300GB+ free on the disk
<mrvn>
You should really be getting much more speed than 1MB/s.
<mrvn>
then again fragmentation can cost a lot.
<mrvn>
I once had a ext3 filesystem so fragmented that it did <100K/s.
mcclurmc has joined #ocaml
<adrien>
can't say for sure, right now, I want my computer back and I'm really pissed at the perf, it's simply awful and I don't believe that it can't find at least 40MB of continuous free space (40MB would be enough for a whole minute)
<adrien>
and that doesn't explain why it's taking so much _cpu_ time
<adrien>
anyway, rant over, will compress everything with lxz (parallel xz) and put it on a much smaller partition but it should be done in two hours, not two weeks
<accel>
adrien: can you explain why ocaml is fragmenting memory?
<mrvn>
because it is defragmenting memory
ygrek has joined #ocaml
Yoric has quit [Quit: Yoric]
Yoric has joined #ocaml
<adrien>
because you can't avoid it
ftrvxmtrx has quit [Read error: Connection reset by peer]
ftrvxmtrx has joined #ocaml
jlenormand has quit [Ping timeout: 255 seconds]
Yoric has quit [Quit: Yoric]
jlenormand has joined #ocaml
jonafan_ has joined #ocaml
jonafan has quit [Ping timeout: 250 seconds]
robthebob has quit [Remote host closed the connection]
kerneis has quit [Ping timeout: 276 seconds]
kerneis has joined #ocaml
<thelema_>
jlenormand: what would be the type of such a function? the best replacement I have is [int -> int list -> int list]
<jlenormand>
thelema_, it isn't typed
<thelema_>
you could do such as camlp4
ftrvxmtrx has quit [Quit: Leaving]
myu2 has joined #ocaml
ftrvxmtrx has joined #ocaml
ygrek has quit [Ping timeout: 240 seconds]
<accel>
what are good examples of ocaml code to read
<thelema_>
accel: the compiler. the stdlib is quite easy to read
<accel>
why are there yacc/*.c files in the ocaml source?
<accel>
hmm, all of ocaml is only 200K LOC ?
<thelema_>
accel: I think for bootstrapping - IIRC, it's possible to bootstrap from C
coucou747 has quit [Quit: 0x2a]
Associat0r has joined #ocaml
* jlenormand
recommends avoiding the typing subdirectory in the compiler source
<jlenormand>
srsly
<thelema_>
true, leave that for last
<jlenormand>
leave that for never!
<thelema_>
I've dug through it, and I'm still sane
<accel>
why? impossible to read?
<accel>
is it just the milner algorithm?
<jlenormand>
milner in spirit
<thelema_>
there's plenty of complexity to deal with a ton of extensions to H-M
<jlenormand>
some stuff, like memo abbrev, is hard to read
<jlenormand>
you also have some stuff like cleanup_types
<jlenormand>
and several type copying functions
<jlenormand>
not to mention dealing with -principle
<jlenormand>
the nicest piece of the code, imho, is typing/parmatch.ml
krfs has joined #ocaml
<accel>
hmm; I genuinely can't figure out what to start
<accel>
so amny choices
<thelema_>
accel: start in stdlib/
<accel>
where is the interprter?
krfs has left #ocaml []
<thelema_>
byterun/
<jlenormand>
do you mean the bytecode interpreter or the repl?
<accel>
the repl
<thelema_>
oh, that's toplevel/
<accel>
nice; thanks
<accel>
!Toploop.toplevel_startup_hook ();
<accel>
what oes the ! mean ?
<accel>
is it boolean negation?
<thelema_>
no, dereference
<jlenormand>
!(ref 5) is 5
<accel>
ocaml code is surprisingly readable
<flux>
accel, you can get a decent hint on what an operator does by entering ( ! );; in the toplevel
<accel>
at the top of topmain.ml
<accel>
there is an: open Clflags
<accel>
however, I can't find a -i clflags.ml
<accel>
where is the Clflags module defined?
<jlenormand>
did you do a search for clflags.mli?
Edward__ has joined #ocaml
<accel>
I grepped wrong
<accel>
my bad
<Julien_T>
Hi
<jlenormand>
high
jlenormand is now known as palomer
<Julien_T>
Did you know a good tool for profiling ocaml code ?
<thelema_>
gprof
<palomer>
I did, but I forgot
<palomer>
If I'm not mistaken, you have to compile your code with some extra flags for gprof to work
<Julien_T>
*I currently use valgrind, function nam are the "natively compiled function name"
<Julien_T>
+but +e
<thelema_>
yes, they're pretty simple to track back to ocaml identifiers, no?
<Julien_T>
actually yes, but I would prefer to have direct link to the code
<Julien_T>
mostly for anonymous function
<thelema_>
those you'll have to name in order to get names for
<flux>
didn't their name contain the source offset encoded?
<thelema_>
there's no prebuilt solution that does what you want, although I imagine many people would appreciate you building such
<thelema_>
flux: no, I think they're just numbered
<Julien_T>
I would appreciate to have the time to build such ^^
<Julien_T>
Is there at least a way to obtain the source offset from the "natively compiled function name" ?
<Julien_T>
by compiling with -g ?
<f[x]>
Julien_T, IIUC you want PR#4888
bzzbzz has joined #ocaml
<Julien_T>
f[x], exactly !
<Julien_T>
thx a lot I will try this :)
BiDOrD has joined #ocaml
<f[x]>
don't forget to flashmob on that item if it works for you!
<f[x]>
:)
<Julien_T>
sorry, what do you mean by flashmob ?
<thelema_>
have tons of people subscribe to it?
<f[x]>
kinda
<f[x]>
there is a working patch and it stays uncommited for several years
<f[x]>
what can we do?
<thelema_>
working != good to apply
<Julien_T>
ok
palomer has quit [Remote host closed the connection]
<thelema_>
it's in the ocaml devs to avoid technical debt
LeNsTR has joined #ocaml
ygrek has joined #ocaml
jm has joined #ocaml
ygrek has quit [Ping timeout: 240 seconds]
boscop has joined #ocaml
ygrek has joined #ocaml
Associat0r has quit [Quit: Associat0r]
ymasory_ has quit [Ping timeout: 240 seconds]
<kaustuv>
Aren't there legal issues to accepting patches from outside INRIA in most cases? Or are patches assume to automatically transfer ownership to INRIA and/or the consortium?
Yoric has joined #ocaml
elehack has joined #ocaml
elehack_ has joined #ocaml
elehack has quit [Client Quit]
elehack_ is now known as elehack
<edwin>
I think I've seen something about that in the OCaml meeting's slides
<edwin>
does anyone who's been at the meeting remember?
ymasory_ has joined #ocaml
ccasin has joined #ocaml
<thomasga>
the issue has been resolved and now external patches (ie. non INRIA patches) can go in
<thomasga>
(if the ocaml developpers think the patch is good)
ttamttam has quit [Remote host closed the connection]
hto has joined #ocaml
hto has quit [Client Quit]
hto has joined #ocaml
LeNsTR has quit [Quit: LeNsTR]
avsm2 has joined #ocaml
metasyntax` has joined #ocaml
m55m has joined #ocaml
m55m has left #ocaml []
m55m has joined #ocaml
m55m has left #ocaml []
ikaros has quit [Quit: Leave the magic to Houdini]
ftrvxmtrx has quit [Quit: Leaving]
<Julien_T>
f[x], Have you already used this patch ?
<Julien_T>
I can't get it work
<Julien_T>
I mean, it don't seems to annotate anything
Yoric has quit [Ping timeout: 255 seconds]
<flux>
julien_t, did you use -g?
coucou747 has joined #ocaml
Yoric has joined #ocaml
myu2 has quit [Remote host closed the connection]
ikaros has joined #ocaml
<Julien_T>
flux, yes I use it
<Julien_T>
maybe I coud check in the asm produced code if there are annotation ?
Yoric has quit [Quit: Yoric]
<Julien_T>
from what I read, assembly code produced should contain .file and .loc but it didn't :/
<gildor>
mfp: ping
<gildor>
mfp: I am trying to use sqlexpr with Lwt
<gildor>
mfp: any example ?
<mfp>
gildor: 1 sec
<mfp>
gildor: it basically boils down to module Sqlexpr = Sqlexpr_sqlite.Make(struct include Lwt let auto_yield = Lwt_unix.auto_yield let sleep = Lwt_unix.sleep end)
<gildor>
mfp: already got this one
<gildor>
mfp: do you use it in any public projects that I can browse ?
<mfp>
as for the rest, it's the same no matter which thread/concurrency monad you're using
<Julien_T>
the patch seems to modify only i386 part, I'll try to report the modification in the amd64 part
<mfp>
I'm looking for one :)
<mfp>
gildor: have you seen README? the stmt syntax is documented there
<adrien>
right, better concentrate on my exam than do three things at once, all badly =/
ulfdoz has joined #ocaml
<mfp>
gildor: a cheap hack to implement one is to create a region of very large size (max_int might cause problems, so take e.g. 1_000_000), then use run_in_region with size 1 for to acquire a read lock, size region_size for write lock
<mfp>
this way you get the multiple non-exclusive read locks - single exclusive write lock semantics
<mfp>
-for
<mfp>
(make_region, run_in_region are in Lwt_util)
<thelema_>
compare looks like it'll still work on pointers outside the heap
<joelr>
that was fast :D thanks
<edwin>
thelema_: so out of memory makes sense now: it runs out of mem while trying to compare my cyclic key
<thelema_>
edwin: ah, that's quite reasonable.
<edwin>
so I'll write my own comparator
<edwin>
that compares by address first
<edwin>
and if they're equal ... skip calling Pervasives
<kaustuv>
thelema_: compare_val checks for Is_in_value_area(), no?
<thelema_>
edwin: I think you'll still have to deal with not equal too
joelr has quit [Quit: joelr]
<thelema_>
kaustuv: oops, I missed that bit.
<edwin>
yep, if not == then they're not equal
<thelema_>
n/m, I was thinking that Hashtbl took a [compare] function, where it really takes a [equal] function
<edwin>
" Equality between cyclic data structures may not terminate"
<edwin>
this should say that it can raise out of memory :D
<edwin>
(also)
gildor has quit [Ping timeout: 246 seconds]
gildor has joined #ocaml
<kaustuv>
structural equality is not tail-recursive, so generally non-termination == oom
<mrvn>
doesn't it run into a stack overflow?
<thelema_>
mrvn: it does - the comparison code turns that into an OOM
<thelema_>
kaustuv: it's possible for it to just run forever, if the comparison stack doesn't grow with each loop
<thelema_>
kaustuv: but you're right - usually there's multiple values put on the stack for each value removed
mnabil has quit [Remote host closed the connection]
lpereira has quit [Quit: Leaving.]
Snark has quit [Quit: Ex-Chat]
ccasin has quit [Quit: Leaving]
hto has quit [Read error: Connection reset by peer]
<kaustuv>
thelema_: I asked this a while back but I guess it got lost in the noise, but how might one add support for compressed inputs and outputs like the old Yoric-era batteries to the current batteries?
Tianon has quit [Ping timeout: 260 seconds]
hto has joined #ocaml
<kaustuv>
Err, I mean not add to the batteries code itself, just how I might combine batteries with camlzip
<hcarty>
kaustuv: There was a blog post about this recently...
Tianon has joined #ocaml
Tianon has quit [Changing host]
Tianon has joined #ocaml
<hcarty>
kaustuv: Never mind. It looks like one is or was planned, but hasn't happened yet.
<thelema_>
kaustuv: batteries-style IO is defined by 4 functions: read (unit -> char), input (string -> int -> int -> int), close (unit -> unit)
<thelema_>
for outputs, it's similar: write (char -> unit), output (string -> int -> int -> int), close (int -> 'a) and flush (unit -> unit)
<thelema_>
implement those, and you can use BatInnerIO.wrap_in/out to make your IO channels
<kaustuv>
right, I found that already, but I don't see how to use that with the GZip module from Camlzip that operates on its own in/out_channel type.
<kaustuv>
Since the Yoric-era batteries had a separate non-camlzip implementation of GZip, I am guessing that it would be impossible to use camlzip unmodified
<thelema_>
you can probably still use the old implementation from yoric-era batteries
<hcarty>
kaustuv: The requisite portion of camlzip could probably be exposed with a patch submitted to the forge
<thelema_>
it'd be a really simple task to partially apply the functions from camlzip
<thelema_>
let open_zip_io fn = let c = Gzip.open_in_chan (Pervasives.open_in_bin fn) in InnerIO.create_in ~read:(fun () -> Gzip.read_byte c) ~input:(Gzip.input c) ~close:(Gzip.close_in c)
<kaustuv>
Thanks, I'll give that a shot
<thelema_>
sometimes I think people would be more satisfied with a solution using monads and functors
<thelema_>
and maybe some phantom types
<kaustuv>
I think you've done a very good job with batteries so far. I've been using it without any hitches for a while now.
<elehack>
thelema_: monads and functors make it harder to realize the "polymorphic" aspect of the IO module, unless it uses first-class modules everywhere.
<kaustuv>
Also, monads are risky for OCaml whose inliner is temperamental. Monads are only effective when >>= and return are almost always inlined.
<elehack>
In many ways, IO is a textbook example of where objects are really a good solution
<elehack>
change prev. line to say just functors - monads have orthogonal problems
<thelema_>
kaustuv: I accept only blame. All the good qualities of batteries were provided by others.
ymasory_ has quit [Read error: Connection reset by peer]
<jonafan>
where should i be looking if i want to peruse the idioms of an ocaml+batteries world?
<thelema_>
hmm... there's a miskept examples/ in the batteries distribution
<jonafan>
yeah, it seems little miskept
<thelema_>
I wish I could release my current mega-project now for you to enjoy, maybe this time next year
<jonafan>
it's hard to absorb what these are showing me
<thelema_>
specifically?
<thelema_>
the examples/euclid/ folder should be more up to date than some of the rest
<jonafan>
nothing specific, but i think there should be something somewhere that is like
<jonafan>
These are the problems we're fixing. Look at this problem. This is how you can do this with batteries. Isn't that awesome?
<thelema_>
yoric had some blog posts that showed cool things with batteries
<jonafan>
i've been kind of frustrated with ocaml lately because it doesn't really seem to have its own idioms, and i'd really really like batteries to fix that
<thelema_>
ah, the way that the ocaml developer community doesn't recommend standard solutions to standard problems.
ulfdoz has quit [Ping timeout: 240 seconds]
ygrek has quit [Ping timeout: 240 seconds]
<jonafan>
many ocaml developers seem to want to disown the majority of the language, myself having been guilty of that for a long time
<jonafan>
by pretending ocaml is haskell
<thelema_>
it's a big, complex language. If you can get your work done by mastering only part of it, more power to you.
<thelema_>
ocaml definitely isn't haskell
drunK has quit [*.net *.split]
jlouis has quit [*.net *.split]
nejimban has quit [*.net *.split]
flux has quit [*.net *.split]
alpounet has quit [*.net *.split]
julm has quit [*.net *.split]
snarkyboojum has quit [*.net *.split]
<hcarty>
jonafan: The OCaml community is perhaps a bit more Perl-like than Python-like... there are often better ways to do something, but rarely "the one true way"
<elehack>
I was talking with someone about a month or so ago who had some related concerns, that it was difficult to step in and figure out what pieces of Batteries you use to do different things.
<elehack>
seems to me that it would be worthwhile to make some good high-level intro and summary documentation a priority before 2.0 is ready.
* elehack
would be happy to work on writing some of that when time permits
<thelema_>
elehack: I just hear "more examples"
drunK has joined #ocaml
jlouis has joined #ocaml
nejimban has joined #ocaml
flux has joined #ocaml
alpounet has joined #ocaml
julm has joined #ocaml
snarkyboojum has joined #ocaml
<thelema_>
when you say that
<elehack>
More examples help.
<elehack>
But a table of the key Batteries data structures and what you would use them for would also be helpful.
<hcarty>
elehack: Paulo Donadeo wrote a few intro blog posts
<jonafan>
Yeah
<hcarty>
A Batteries Book
<elehack>
heh, that sounds like a great idea and a tremendous amount of work
<jonafan>
It's hard to tell what's being used here
<hcarty>
PLEAC for Batteries could be a useful interim goal
<hcarty>
And/or Rosetta Code
<thelema_>
hcarty: I agree on the pleac front
edwin has quit [Remote host closed the connection]
<thelema_>
elehack: by "key", you mean things like... IO? Enum? polymorphic map/set? multimap? Rope/Vect? substring?
<elehack>
thelema_: I probably won't include IO in that list, but would include the rest.
<elehack>
and it can address some questions such as Enum vs. Stream vs. LazyList
alexyk has joined #ocaml
* Yoric
learns that he has given his name to a geological era.
<Yoric>
funny, that
<Yoric>
Still, time to go to bed.
<Yoric>
Happy New year everybody, though.
Yoric has quit [Quit: Yoric]
<jonafan>
happy new year!
<kaustuv>
Alas, poor Yoric left too soon!
ikaros has quit [Quit: Leave the magic to Houdini]
alexyk has quit [Quit: alexyk]
alexyk has joined #ocaml
<hcarty>
elehack: I think Batteries' IO module is key, though perhaps not a key data structure.
smerz has quit [Quit: Ex-Chat]
<elehack>
hcarty: absolutely. what I was thinking of with the table is more of a comparative table for data structures themselves as one piece of an introductory/survey document.
<hcarty>
elehack: Ah, agreed then :-)
alexyk has quit [Read error: Connection reset by peer]
coucou747 has quit [Read error: Connection reset by peer]
elehack has quit [Quit: Headed out, possibly to home]
coucou747 has joined #ocaml
alexyk has joined #ocaml
Edward__ has quit []
accel has quit [Disconnected by services]
alexyk has quit [Read error: Connection reset by peer]
alexyk has joined #ocaml
flux has quit [Remote host closed the connection]
flux has joined #ocaml
mfp has quit [Ping timeout: 260 seconds]
alexyk has quit [Read error: Connection reset by peer]
mfp has joined #ocaml
coucou747 has quit [Ping timeout: 260 seconds]
maurer_ has left #ocaml []
decaf has joined #ocaml
decaf has left #ocaml []
alexyk has joined #ocaml
decaf has joined #ocaml
coucou747 has joined #ocaml
alexyk has quit [Read error: Connection reset by peer]