mbishop changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | Grab OCaml 3.10.2 from http://caml.inria.fr/ocaml/release.html (featuring new camlp4 and more!)
jprieur has quit ["Connection reset by beer"]
goalieca_lappy has quit [Read error: 113 (No route to host)]
nuncanada has joined #ocaml
tetsuo_ has quit [Remote closed the connection]
vfdfdfvd has quit ["Leaving."]
middayc has joined #ocaml
mfp has quit [Read error: 110 (Connection timed out)]
orbitz has joined #ocaml
<orbitz> hello
<orbitz> suggestions on how to shuffle a list?
<mbishop> fisher-yates...
<orbitz> so i hav eto construct a list for every iteration?
<mbishop> uses arrays there but *shrug*
<orbitz> that's an Array
<orbitz> meh i'll just use an array
<mbishop> or you could just change the list into an array, shuffle, then change it back :P
kelaouch1 has quit [Read error: 110 (Connection timed out)]
|Catch22| has quit [Read error: 104 (Connection reset by peer)]
netx has quit [Read error: 104 (Connection reset by peer)]
middayc_ has joined #ocaml
<thelema> orbitz: while List.length > 0 do move random element from original list to head of new list; done
middayc has quit [Read error: 110 (Connection timed out)]
<orbitz> thelema: slightly better:)
<orbitz> does ocaml have a fnction that takes a range and produces a list of integers in that range? i'm not seeing anything obvious in List module
<thelema> let rec (--) = fun m n -> if m >= n then [] else m::((m + 1) -- n)
<orbitz> so no?
<thelema> (my standard lib has this function)
<thelema> my stdlib != INRIA's stdlib
<orbitz> that's not very stnadard!
<thelema> I'm hoping to make a new standard by improving sufficiently on the old one.
<orbitz> ok
<orbitz> i'm not sure -- is a good funciton name
<orbitz> for that
* orbitz wheee's
<orbitz> just need to make a main funciton for this and i'v egot a decent enough poker hand simulator
<thelema> 3 -- 20
<thelema> it seems nice to me.
<orbitz> it's not particularly cobvious
<orbitz> and -- rings to me of subtraction, not range
<orbitz> for instance a set difference
<thelema> got a better idea? clearly -- isn't subtraction.
<thelema> it's not decrement.
<orbitz> it rings to me o fa subtraction opertion, such as a set difference
<orbitz> i like List.seq and List.seqs
<orbitz> where seqs allows you to specify a step
<thelema> List.init should suffice for most of this (also missing from INRIA's stdlib)
<orbitz> IMO -- isn't clear enough to remeber that it is a range operation which is why i would avoid it and generally not use it, bu ti's your lib :)
<thelema> let seq m n = List.init (n-m) (fun i -> i + m)
<thelema> "feedback noted". Thanks for trying to convince me - I'm still convincable, but not there yet.
<thelema> let seqs m n step = List.init ((n-m)/step) (fun i -> m+(i*step))
<thelema> with List.init, maybe I should just drop --
middayc_ has quit []
AxleLonghorn has joined #ocaml
AxleLonghorn has left #ocaml []
adu has joined #ocaml
ikaros has joined #ocaml
kelaouchi has joined #ocaml
Mr_Awesome has joined #ocaml
StoneNote has joined #ocaml
StoneNote has quit []
Demitar has quit [Remote closed the connection]
pango_ has quit [Remote closed the connection]
pango_ has joined #ocaml
<bluestorm> thelema: what about "range 3 20" ? :p
<bluestorm> or yeah, seq
<bluestorm> orbitz: in case you're still insterested in list shuffling : http://okmij.org/ftp/Haskell/perfect-shuffle.txt
<flx> also there's the thing that conveniently using (--) means opening a module
<flx> with (--) I would expect a closed range, though, where as with a function 'range' I would expect a half-open range
Yoric[DT] has joined #ocaml
schme has joined #ocaml
evn_ has joined #ocaml
ygrek has joined #ocaml
adu has quit ["Bye"]
nuncanada has quit [Read error: 110 (Connection timed out)]
nuncanada has joined #ocaml
goalieca_lappy has joined #ocaml
goalieca_lappy has quit [Client Quit]
mfp has joined #ocaml
musicallyut has joined #ocaml
nuncanada has quit [Read error: 113 (No route to host)]
nuncanada has joined #ocaml
musically_ut has quit [Remote closed the connection]
Linktim has joined #ocaml
tetsuo_ has joined #ocaml
Jedai has joined #ocaml
coucou747 has joined #ocaml
hkBst has joined #ocaml
vfdfdfvd has joined #ocaml
middayc has joined #ocaml
jprieur has joined #ocaml
<pango_> I'm against a range operator (or function) that would 'materialize' the range as an int list. The demand for such operator comes from people that are used to other languages that implement that idiom efficiently; that will lead to even more frustration.
evn_ has quit [Read error: 113 (No route to host)]
<flx> well, one does need sequences of integers at times
<flx> are you suggesting using streams instead?
bluestorm has quit [Read error: 113 (No route to host)]
bluestorm has joined #ocaml
<pango_> int stream, int * int, another ADT, educate people to use ocaml idioms, take whole idioms from other languages (either ranges, or subarrays and substrings from ML,...), but certainly not returning an int list
<pango_> that's easy, but doesn't scale
<flx> pervasive streams support would be nice
Jedai has quit [Read error: 113 (No route to host)]
<flx> (meaning thoroughly supported in standard libraries and pattern matching)
<flx> also it would be nice to have functional streams
<flx> essentially they would be lazy lists then
kronbaar has joined #ocaml
<kronbaar> hello
<kronbaar> how can I specify a target directory for binaries? I want to keep .ml and .mli together in src/ and everything else in bin/
<flx> I don't think you can without wrapping the compilation process with copying etc
kelaouchi has quit [Client Quit]
<pango_> you get pattern matching over streams by using camlp4
* pango_ nods
<pango_> It's supposed to be a feature of ocamlbuild, but I haven't used it yet
<pango_> (unless I'm misreading that)
<pango_> "ocamlbuild has so-called “hygiene” rules that state that object files (.cmo, .cmi, or .o files, for instance) must not appear outside of the build directory."
<Yoric[DT]> Personally, I'd have ranges as either an ADT or a ExtLib Enum.t .
jlouis has quit [Remote closed the connection]
schme has quit [Remote closed the connection]
jlouis has joined #ocaml
musicallyut has quit [Remote closed the connection]
pango_ has quit [Excess Flood]
pango_ has joined #ocaml
Demitar has joined #ocaml
middayc has quit []
Linktim_ has joined #ocaml
Linktim has quit [Read error: 110 (Connection timed out)]
<orbitz> well, until we rewrite all of ocaml to support a range concept, i'll take an int list
Yoric[DT] has quit [Remote closed the connection]
Yoric[DT] has joined #ocaml
musically_ut has joined #ocaml
pango_ has quit [Remote closed the connection]
pango_ has joined #ocaml
jlouis has quit ["Leaving"]
jlouis has joined #ocaml
|Catch22| has joined #ocaml
filp has joined #ocaml
eelte has joined #ocaml
ikaros_ has joined #ocaml
middayc has joined #ocaml
coucou747 has quit [Read error: 113 (No route to host)]
pango_ has quit [Remote closed the connection]
ikaros has quit [Read error: 110 (Connection timed out)]
pango_ has joined #ocaml
nuncanada has quit ["Leaving"]
Linktim- has joined #ocaml
middayc_ has joined #ocaml
Linktim_ has quit [Read error: 110 (Connection timed out)]
<rwmjones> RobertFischer pong
AxleLonghorn has joined #ocaml
middayc has quit [Read error: 110 (Connection timed out)]
pango_ has quit [Remote closed the connection]
pango_ has joined #ocaml
Yoric[DT] has quit [Read error: 113 (No route to host)]
Yoric[DT] has joined #ocaml
Jedai has joined #ocaml
ofaurax has joined #ocaml
jlouis has quit ["brb -- box change"]
jlouis has joined #ocaml
nuncanada has joined #ocaml
oublions has joined #ocaml
eelte has quit [Read error: 110 (Connection timed out)]
oublions is now known as coucou747
Morphous has joined #ocaml
AxleLonghorn has left #ocaml []
Amorphous has quit [Read error: 110 (Connection timed out)]
seydar has joined #ocaml
seydar has left #ocaml []
magnus has joined #ocaml
eelte has joined #ocaml
<sporkmonger> i've got an in_channel, and i want to read everything until EOF, what's the fastest, most efficient way of doing this?
<sporkmonger> i tried using the input method with a buffer of 1024 chars, but it seems that the result string ends up with a length that's a multiple of 1024
<sporkmonger> which really isn't what i was looking for
<sporkmonger> i basically just want:
<sporkmonger> let read_all in_channel : string =
<bluestorm> there is a function for that in extlib
<sporkmonger> cool, thanks
schme has joined #ocaml
<jlouis> it works as long as you don't read in a half terabyte ;)
<sporkmonger> heh
<sporkmonger> only need to read in maybe 10-20kb at a time max
<sporkmonger> i'll probably throw a 300mb file at it at some point just for giggles, but yeah
<sporkmonger> more an issue of having to call the thing 3 billion times
<sporkmonger> bah, i wish OMake had a OCamlMkTop macro
<sporkmonger> everything i've tried passing to ocamlmktop isn't causing extlib to get linked properly
<sporkmonger> keeps whining about either not being able to find extlib or not know what this 'Std' thing is :-P
<orbitz> HELLOOO
<sporkmonger> what exactly would i pass to ocamlmktop to get extlib linked?
<pango_> sporkmonger: 32bit or 64bit arch? On 32bit archs, # Sys.max_string_length ;;
<pango_> - : int = 16777211
<sporkmonger> probably 32 bit
<pango_> so you won't slurp a 300mb at once
<sporkmonger> hmm
coucou747 has quit [Read error: 110 (Connection timed out)]
<sporkmonger> ok, well the issue is that i have an in_channel
<sporkmonger> stdin in this case
<sporkmonger> and i need to replay it N times
<sporkmonger> figured i'd just read it into a string, wrap a stream around it
<sporkmonger> but 16777211 is definitely going to be too small
<sporkmonger> (though i'd still like to know how to get extlib linked)
<sporkmonger> so if i can't store it in a string, what other options do i have?
<sporkmonger> (i miss my rewind method already)
<thelema> val input_lines : Pervasives.in_channel -> string Enum.t
<thelema> (assuming the data breaks up over lines reasonably.
<sporkmonger> not sure i follow
<sporkmonger> it's binary data
<sporkmonger> can be images, avis, text, anything
<sporkmonger> will usually be text though
<thelema> fixed size records... no existing function in extlib, but shouldn't be difficult to modify existing routine to just read in x bytes
<sporkmonger> -sigh- shoot me now
<sporkmonger> so, before i forget
<sporkmonger> ocamlmktop, how do i get extlib linked?
<sporkmonger> using omake
<sporkmonger> my build target looks like this right now:
<sporkmonger> squish_top: $(CMO_FILES)
<sporkmonger> $(OCAMLFIND) $(OCAMLMKTOP) -linkpkg nums.cma $(OCAML_LIBS) $(CMO_FILES) -o $@
<bluestorm> i use extlib with ocamlfind
<sporkmonger> yeah, i still haven't quite figured ocamlfind out yet
<sporkmonger> findlib knows about extlib, but i'm still really shaky on what that does for me
<thelema> let input_fields ch l = Enum.from (fun () -> try let b = String.make l in if input ch b 0 l = 0 then raise Enum.No_more_elements else b)
<thelema> no, can do that better...
<sporkmonger> thelema: i'm not sure i see what that does exactly
<sporkmonger> Admittedly, haven't touched enums at all yet
<sporkmonger> assuming enums in ocaml are similar to what i'm used to elsewhere
<sporkmonger> i guess i don't see what enums buy me here
<thelema> these enums are similar to lazy lists
<thelema> they buy you a way past the string size limit
<thelema> and if your source data fits in memory, they allow replaying
* sporkmonger is lost
<sporkmonger> ok, lazy lists...
<sporkmonger> are lists who's internals don't get evaluated until you ask for em?
<thelema> yes
<sporkmonger> well, i have to be able to replay regardless of whether it all fits in memory
<thelema> sporkmonger: in that case, why not just read the file anew each time?
<thelema> why bother caching the data?
<sporkmonger> because the file is stdin?
<thelema> if stdin doesn't fit in memory, you lose.
<sporkmonger> true
<sporkmonger> ok, so that's probably something of a moot point
<sporkmonger> assume it fits in memory then
<sporkmonger> this thing won't be running on machines with less than 4GB anyhow
<thelema> then this way will work nicely.
<sporkmonger> absolutely worst case is maybe it gets run on a VPS with 256mb allotted
<sporkmonger> ok, so what exactly is the return value of the function you gave me there?
<sporkmonger> i assume an enum?
<thelema> yes.
<sporkmonger> string Enum.t? or?
<thelema> string Enum.t
<sporkmonger> ok, so i get a bunch of strings in an enum, and i read each of them one at a time then?
<thelema> yup.
<sporkmonger> hmm
<sporkmonger> this seems a little round-about
<thelema> you'd rather have a bool Enum.t?
<sporkmonger> no
<sporkmonger> because i have to turn around and wrap that enum with a stream
<thelema> ?? enums do a great job of offering a stream-like interface.
<thelema> the basic operations on an Enum are: count, next, clone
<sporkmonger> ok, so first, how do i replay the thing?
<sporkmonger> is that clone?
<thelema> clone it and play the clone.
<sporkmonger> ok
<sporkmonger> the issue is that i need the data bit-by-bit, effectively byte-by-byte with a one byte buffer
<thelema> not difficult to wrap one enumeration into another.
<sporkmonger> if the enum contains strings, yeah
<sporkmonger> that's basically what i'd have to do
<sporkmonger> if i clone an enum that wraps another enum, that doesn't cause issues does it?
<thelema> it depends on how good the clone function is - if you construct your enum with Enum.from, clone is created to build the entire enum as a list. Which would cause problems creating a list of booleans.
<thelema> because of the memory space used by booleans vs. strings
<sporkmonger> well, there's spots where i do stuff like: bit * 128
<sporkmonger> so booleans don't make much sense
<thelema> but you could clone the inner enum and re-apply the conversion to it.
<sporkmonger> yeah
<sporkmonger> ok, so i'm sold on the enum idea, but enum's seem to be in extlib
<sporkmonger> and i'm still having link issues with extlib :-P
<sporkmonger> i'm my OMakefile, i've got
<sporkmonger> OCAMLPACKS[] = annexlib extlib num
<sporkmonger> and
<sporkmonger> OCamlLibrary(libsquish, $(FILES))
<sporkmonger> and
<sporkmonger> squish_top: $(CMO_FILES)
<sporkmonger> $(OCAMLFIND) $(OCAMLMKTOP) -linkpkg nums.cma $(OCAML_LIBS) $(CMO_FILES) -o $@
<sporkmonger> and ocamlmktop is complaining about not being able to find Enum or Std
<sporkmonger> because, i assume, nothing on that link links to extlib
<sporkmonger> 8line
<sporkmonger> *line
<sporkmonger> just not sure how i specify extlib in there
<sporkmonger> aha
<sporkmonger> -package
harlos has quit ["[BX] I see your BitchX is as big as mine!"]
<sporkmonger> what happens when two libraries both have a module with the same name?
<sporkmonger> just wondering since both extlib and annexlib have an Option module
<pango_> sporkmonger: you lose
<Yoric[DT]> Latest wins.
<Yoric[DT]> iirc
<sporkmonger> bleh
<sporkmonger> oh well, not a big deal since i'm not using the module
<bluestorm> you can still use any of them with the prefix name (Extlib.Option) anyhow
<sporkmonger> Oh ok
<sporkmonger> that's good to know
<thelema> bluestorm: eh? Extlib.Option?
<bluestorm> hmm
* Yoric[DT] never saw that.
<bluestorm> doesn't Extlib has a common module ?
<bluestorm> -s+ve
<bluestorm> i must be wrong then
<bluestorm> then you would have to create one yourself
<bluestorm> an Extlib module, including all the modules of extlib as submodules
<thelema> extlib is designed to drop in and replace/extend stdlib modules.
<bluestorm> thelema: how would creating an outer module affect this ?
<thelema> well, I guess there could be an extlib.ml that does [module A = A module B = B] for each extlib module
<bluestorm> as far is i know, the parts intended to overwrite the stlib are in Ext* modules and have to be explicitely opened anyway
<thelema> err, module A = ExtA module B = ExtB (many extlib modules have ext predix)
<thelema> so instead of [open ExtList], one would do [open Extlib.List]? I guess no big deal.
munga has joined #ocaml
<bluestorm> open Extlib.ExtList, yes
<bluestorm> hm
<Yoric[DT]> ok
znutar has joined #ocaml
jprieur has quit ["Connection reset by beer"]
ofaurax has quit ["Leaving"]
Yoric[DT] has quit ["Ex-Chat"]
magnus has quit ["Lost terminal"]
ygrek has quit [Remote closed the connection]
ygrek has joined #ocaml
musically_ut has quit [Remote closed the connection]
Morphous is now known as Amorphous
musically_ut has joined #ocaml
<palomer_> extlib is really cool!
<thelema> palomer_: I agree - that's why I've integrated most of it into an improved stdlib
kronbaar has quit ["Leaving"]
Linktim_ has joined #ocaml
<sporkmonger> yeah, i'm gonna have to agree, extlib -is- cool
schme has quit [Read error: 110 (Connection timed out)]
Linktim- has quit [Read error: 110 (Connection timed out)]
Demitar has quit ["Burn the land and boil the sea. You can't take the sky from me."]
palomer__ has joined #ocaml
thelema_ has joined #ocaml
Linktim- has joined #ocaml
palomer_ has quit [Read error: 110 (Connection timed out)]
nuncanada_ has joined #ocaml
middayc_ has quit []
nuncanada_ has quit [Client Quit]
mwc has joined #ocaml
Linktim_ has quit [Read error: 110 (Connection timed out)]
munga has quit ["Ex-Chat"]
ygrek has quit [Remote closed the connection]
Linktim- has quit [Read error: 110 (Connection timed out)]
hkBst has quit ["Konversation terminated!"]
thelema has quit [Read error: 110 (Connection timed out)]
filp has quit ["Bye"]
bluestorm has quit ["Konversation terminated!"]
seafood_ has joined #ocaml
tetsuo_ has quit ["Leaving"]
seafood_ has quit []
<palomer__> jhttp://ocaml.pastebin.com/m2fe3bd1c <--can someone tell me why im getting this error?
<palomer__> http://ocaml.pastebin.com/m6aaa0167 <--slightly simpler and prettier testcase
znutar has quit [Read error: 110 (Connection timed out)]
<thelema_> palomer__: get_all_right_siblings_specific takes an option as argument.
thelema_ is now known as thelema
<palomer__> ahhhh
* palomer__ hits himself
ikaros_ has quit [Connection timed out]
ikaros_ has joined #ocaml
vfdfdfvd has quit [Remote closed the connection]
<palomer__> http://ocaml.pastebin.com/m15b9bc77 <--could someone explain to me these errors?
<palomer__> (playing around with optional arguments)
<thelema> palomer__: if possible, end your argument list with a non-optional argument, so ocaml knows when you're currying.
<thelema> and you probably mean Maryland Heights Community Center
<thelema> 2344 McKelvey Road
<thelema> Maryland Heights, MO 63043
<thelema> (314) 434-1919.
<thelema> hmm, that's odd. let's try pasting again...
<thelema> signature_block_skel s ~default_signature_environment:defsigenv
<thelema> (on line 6)
<thelema> That probably won't fix the error on line 6, but it's more correct.
<palomer__> hrmph
<palomer__> thx
<palomer__> thelema, are you the maintainer of extlist?
ikaros_ has quit ["segfault"]
<jlouis> palomer__, beginning to like ML?
LordMetroid has joined #ocaml
<palomer__> it's cool
<palomer__> especially for my project
<palomer__> weeee, everything works!
Mr_Awesome has quit ["aunt jemima is the devil!"]
<thelema> palomer__: not exactly. I've adopted most of the code for my own stdlib-extension-project
bzzbzz has quit [Remote closed the connection]
bzzbzz has joined #ocaml
<jlouis> I like yminsky's idea that ML hits the sweet spot between abstraction, speed and safety
<jlouis> I tend to agree with him
<mbishop> I agree as well, ML seems the perfect balance
bzzbzz has quit ["leaving"]
palomer__ has quit [Read error: 110 (Connection timed out)]
palomer__ has joined #ocaml
<sporkmonger> i really wish there was more information given when you get a syntax error
<sporkmonger> i miss "unexpected kEND, expected blah, blah"
seafood_ has joined #ocaml
<mbishop> I don't find the syntax errors too hard..typically it gives you line, and even column numbers so you're at least in the right area
seafood_ has quit []
lordmetroid_ has joined #ocaml
lordmetroid_ has quit [Client Quit]
yangsx has joined #ocaml
<palomer__> if it wasn't for emacs, I don't know how I would deal with syntax errors
znutar has joined #ocaml
LordMetroid has quit [Read error: 110 (Connection timed out)]
znutar has quit [Client Quit]
<sporkmonger> re syntax errors
<sporkmonger> i should just remember that, for me, the leading cause is omitting "then" from if statements
<sporkmonger> and just always assume that's what i've done
<sporkmonger> i may eventually get around to adjusting the syntax highlighter to yell at me if it's not there