flux changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | 3.11.0 out now! Get yours from http://caml.inria.fr/ocaml/release.html
seafood has joined #ocaml
AxleLonghorn has joined #ocaml
seafood has quit [Client Quit]
ulfdoz has quit [Read error: 110 (Connection timed out)]
pantsd has joined #ocaml
seafood has joined #ocaml
Slower has joined #ocaml
<Slower> so, total newb here.. I'm just trying to figure out how you can recurse or loop through an array..
<Slower> so I figured out a list..
<Slower> let rec print_list l =
<Slower> match l with
<Slower> [] -> ()
<Slower> | x::xs -> (Printf.printf "%s " x; print_list xs)
<Slower> ;;
<hcarty> Slower: Array.iter?
<Slower> hmm :)
<hcarty> Slower: Which is, IIRC, implemented with a for loop
<mrvn> Slower: let rec loop = function n when n = Array.length array -> () | n -> ...; loop (n+1)
<mrvn> for i = 0 to Array.length array - 1 do ... done
<Slower> hmm
<Slower> ok lemme mess with those :)
<Slower> I can't believe how much I suck coming from C type background to ocaml :)
<hcarty> Slower: It can be an interesting transition :-)
<mrvn> Arrays are imperative and not functional so youare kind of stuck with imperative features to walk over them.
<Slower> huh
<Slower> it's odd to me that Sys.readdir() returns an array..
<Slower> err, sorry no () :)
* Slower suits his nick again!
<Slower> woot!
<mrvn> Slower: yeah, odd that one.
<Associat0r> hcarty : is there no Array.map ?
<hcarty> Associat0r: There is
seafood has quit []
<mrvn> Why does Sys.readdir return an array? Makes no sense. A list would be so much easier to create.
seafood has joined #ocaml
<Alpounet> moreover, that's not like if its mutability was useful...
seafood has quit [Client Quit]
<Slower> mrvn: so..
<Slower> let rec print_array a =
<Slower> for i = 0 to Array.length a - 1 do
<Slower> Printf.printf "%s\n" a.(i)
<Slower> done;;
<mrvn> -rec
<Slower> oh yeah
<Slower> don't need rec
<Slower> that does seem very imperitive :)
<mrvn> there is a "for" in there
<Slower> can I reassign values of slots in an array?
<Alpounet> a.(i) <- stuff
<Slower> aha
<Slower> holy moly
<Slower> like real live variables
travisbrady has quit []
<Alpounet> yep
<hcarty> Slower: http://www.ffconsultancy.com/products/ocaml_for_scientists/chapter1.html might be a useful intro coming from a C background
<Alpounet> good night guys
Alpounet has quit ["Quitte"]
<hcarty> Slower: The OCaml manual's intro chapter (http://caml.inria.fr/pub/docs/manual-ocaml/manual003.html) and Jason Hickey's book (http://www.cs.caltech.edu/courses/cs134/cs134b/book.pdf) are quite good as well
<Slower> yeah
<Slower> I've been reading tutorials and have umm Practical Ocaml
<Slower> I do ok at simple functions and stuff
<mrvn> Not having to worry about memory leaks or segfaults is a great relive.
<Slower> until I have to make constructs and stuff
<Slower> mrvn: yeah I personally find that's not that hard for me anymore :)
<hcarty> Practical OCaml has received less than stellar reviews from inside the community. I have not read it personally though.
<Slower> ah ok
seafood_ has joined #ocaml
<Slower> I like the concurrency ideas of FP
<Slower> although I understand ocaml doesn't implement that
<Slower> or maybe I'm wrong..
<Slower> anyway, I'm going to try learning it :)
<hcarty> It's well worth learning, though this room is somewhat biased on that topic...
<mrvn> the GC isn't multithreaded. Big problem for the future.
<Slower> hehe
<Slower> well I'd imagine once I learn it I'll be able to learn haskell too
<m3ga> Slower: ocaml is more forgiving during the learning stages because you can drop back to imperative coding to get around specific problems, then come back later and do it the correct FP way later.
<m3ga> haskell is however, very much worth learning
<Slower> righto
<Slower> thanks
<hcarty> There are a number of concurrency and parallelism libraries floating around for OCaml, so such items are not completely out of reach.
<Slower> heh, ok, another dumb question..
<Slower> on a match, can you set up a 'everything else' match?
<Slower> let entry = a.(i) in
<Slower> match entry with
<Slower> | "." -> Printf.printf " -- .";
<Slower> | ".." -> Printf.printf " -- ..";
<Slower> | Printf.printf "%s\n" a.(i)
<Slower> so the last one I just want 'everything else'
<Slower> err, oh and I'm using a.(i) there still
<Slower> also match result for "." could be a next or no-op
<hcarty> Slower: You might want to put these in a pastebin
<Slower> oh, I thought they were pretty small still :)
<m3ga> Slower: just pust something as the last match. call it 'everything' or mor idiomatically, use '_' (underscore)
<hcarty> But yes, the "catch all" match is "| _ -> ..."
<Slower> ok
<hcarty> I'm off for the night
vbmithr has quit [hubbard.freenode.net irc.freenode.net]
ozzloy has quit [hubbard.freenode.net irc.freenode.net]
<hcarty> Slower: Have fun learning the language
<Slower> thanks :)
<mrvn> Actualy in this case: | name -> Printf.printf "%s\n" name
vbmithr has joined #ocaml
ozzloy has joined #ocaml
<mrvn> Slower: and you don't need the let.
<Slower> is that normal style to leave it off?
<mrvn> Slower: yes
Ched has quit [Read error: 110 (Connection timed out)]
Ched has joined #ocaml
willb has joined #ocaml
rg has joined #ocaml
AxleLonghorn has left #ocaml []
seafood_ has quit [Connection timed out]
rg has quit ["Leaving"]
komar_ has joined #ocaml
<det> mrvn, hey
Associat0r has quit []
mpwd has quit []
mpwd has joined #ocaml
thelema has joined #ocaml
mpwd has quit []
pantsd has quit [Read error: 60 (Operation timed out)]
pantsd has joined #ocaml
eydaimon has joined #ocaml
ikaros has joined #ocaml
ikaros has quit ["Leave the magic to Houdini"]
willb has quit ["Leaving"]
m3ga has quit ["disappearing into the sunset"]
jonafan_ has joined #ocaml
jonafan has quit [Read error: 110 (Connection timed out)]
Lomono has quit ["Don't even think about saying Candlejack or else you wi"]
Snark has joined #ocaml
angerman has joined #ocaml
schme has joined #ocaml
tomaw has quit [D-lined]
smimou has joined #ocaml
tomaw has joined #ocaml
komar_ has quit [Read error: 104 (Connection reset by peer)]
komar_ has joined #ocaml
mpwd has joined #ocaml
sgnb` has quit [Read error: 104 (Connection reset by peer)]
sgnb` has joined #ocaml
rjack has joined #ocaml
m3ga has joined #ocaml
th5 has joined #ocaml
_zack has joined #ocaml
Camarade_Tux has joined #ocaml
maxote has joined #ocaml
mpwd has quit []
jeanbon has joined #ocaml
mpwd has joined #ocaml
jamii has quit [Read error: 110 (Connection timed out)]
barismetin has joined #ocaml
hkBst has joined #ocaml
_zack has quit ["Leaving."]
smimou has quit ["bli"]
mpwd has quit []
_zack has joined #ocaml
ulfdoz has joined #ocaml
Yoric[DT] has joined #ocaml
Yoric_ has joined #ocaml
Yoric_ has quit ["Ex-Chat"]
Yoric[DT] has quit ["Ex-Chat"]
jeanbon has quit ["cours."]
_zack has quit ["Leaving."]
rAphael_ has joined #ocaml
noj has joined #ocaml
julm has quit [Read error: 113 (No route to host)]
m3ga has quit ["disappearing into the sunset"]
julm has joined #ocaml
LeCamarade|Away is now known as LeCamarade
ergodick has joined #ocaml
Associat0r has joined #ocaml
schme has quit [Read error: 113 (No route to host)]
rwmjones has quit ["Leaving"]
rwmjones has joined #ocaml
Yoric[DT] has joined #ocaml
<Yoric[DT]> hi
seafood has joined #ocaml
Alpounet has joined #ocaml
_andre has joined #ocaml
jm has joined #ocaml
<Yoric[DT]> Does anyone know if there's a way of inspecting a closure at runtime, to separate the data from the actual compiled function?
<Yoric[DT]> (I'm thinking about using this to migrate pseudo-threads between CPUs)
julm has quit [Read error: 113 (No route to host)]
seafood has quit [Read error: 110 (Connection timed out)]
_zack has joined #ocaml
Axioplase has joined #ocaml
jeremiah has quit [Read error: 104 (Connection reset by peer)]
<Alpounet> Did you look at OCaml's compiler code for that ?
jm has quit [Read error: 110 (Connection timed out)]
jm has joined #ocaml
jeremiah has joined #ocaml
jm has quit [Read error: 60 (Operation timed out)]
jm has joined #ocaml
<Yoric[DT]> Alpounet: doing that at the moment.
<Alpounet> good luck
<Alpounet> there hasn't been any effort on documenting the compiler
<Alpounet> When doing some tests for my JSSP application, I suffered (even physically :-p) from that.
rjack has quit ["leaving"]
willb has joined #ocaml
sporkmonger has joined #ocaml
itewsh has joined #ocaml
Yoric[DT] has quit [Read error: 110 (Connection timed out)]
ergodick1 has joined #ocaml
jmou has joined #ocaml
ergodick has quit [Read error: 60 (Operation timed out)]
jm has quit [Read error: 110 (Connection timed out)]
bombshelter13_ has joined #ocaml
smimou has joined #ocaml
Snark has quit ["Ex-Chat"]
jmou has quit [Read error: 110 (Connection timed out)]
barismetin has quit [Remote closed the connection]
sporkmonger has quit []
jmou has joined #ocaml
itewsh has quit [Read error: 60 (Operation timed out)]
itewsh has joined #ocaml
OChameau has joined #ocaml
Yoric[DT] has joined #ocaml
jmou has quit [Read error: 110 (Connection timed out)]
jmou has joined #ocaml
sporkmonger has joined #ocaml
itewsh has quit [Connection timed out]
sporkmonger has quit [Client Quit]
itewsh has joined #ocaml
jmou has quit [Read error: 60 (Operation timed out)]
<Yoric[DT]> Alpounet: yeah, I can relate.
jmou has joined #ocaml
barismetin has joined #ocaml
kaustuv has joined #ocaml
ikaros has joined #ocaml
itewsh has quit [Connection timed out]
itewsh has joined #ocaml
itewsh has quit [Read error: 60 (Operation timed out)]
itewsh has joined #ocaml
Yoric[DT] has quit ["Ex-Chat"]
yziquel has joined #ocaml
<yziquel> 078 783 59 49
jm has joined #ocaml
jmou has quit [Read error: 110 (Connection timed out)]
th5 has quit []
smimou has quit ["bli"]
<mrvn> Anyone used signals in coaml before? Specifically SIGIO. Anything to watch out for? I guess I won't be able to run/touch anything ocaml in the signal handler, right?
itewsh has quit [Success]
itewsh has joined #ocaml
<palomer> Camarade_Tux, you around?
<Camarade_Tux> palomer, yeah but on the phone
<flux> btw, wouldn't it be possible to write a campl4 extension that upon module_type_of_sig Foo would open foo.cmi and produce the type signature of said module?
ergodick1 has left #ocaml []
willb has quit [Read error: 110 (Connection timed out)]
itewsh has quit [Read error: 110 (Connection timed out)]
itewsh has joined #ocaml
jm has quit [Read error: 110 (Connection timed out)]
<mrvn> wouldn't it be easier to make dir/file.ml[i] equivalent to module Dir = struct module File = ...?
jm has joined #ocaml
bluestorm has joined #ocaml
<flux> I don't see how that has any relevance to this?
<mrvn> flux: because then include Dir.File would work
<flux> mrvn, say I have module Foo defined by files foo.mli and foo.ml, how would that allow me to extend it with another module that includes its interface?
<yziquel> has anyone tried to adapt ocamlbuild to jocaml?
<mrvn> flux: 3013 is justan extension of 2737 to include files as well as directly declared modules or not?
<flux> mrvn, well, it is sort of an extension that would make .mli generate module types, while the .ml generates modules
<flux> the problem is gaining access to them :)
<mrvn> and that part is better solved by making paths equivalent to module Name = ...
<flux> mrvn, perhaps I didn't quite understand what you meant by making those mli-files equivalent to some structure
<flux> and where does 'module type' get in?
psnively has joined #ocaml
jeanbon has joined #ocaml
<mrvn> flux: Say you have foo.ml and in there you write module Bla = ... module Foo = struct include Bar ... end. That already works.
<mrvn> flux: Now instead of defining Bla inside foo.ml moving it to bla.ml should be equivalent.
<flux> isn't it?
<mrvn> That is what 3013 wants to solve or not?
<flux> it deals with module signatures, not module values?
<flux> I can do this just fine: module ExtList = struct include List ..extra stuff here.. end
<mrvn> flux: The difference between struct and sig is already covered by 2737
<flux> I think it is a bit different, as the comment says it. it expects access to something that hasn't been explicitly defined. but I suppose it'd be the same with 3013 too, even if the .mli-file doesn't exist..
<flux> but yes, sig_of_struct and module_type_of_struct would be the same thing
<flux> only the motivation is explained differently
<flux> what I was suggesting was that camlp4 could be made to implement the feature, but only in the case when the referred module is a 'top level' module with a .cmi-file.
<flux> it'd be darn interesting if camlp4 could interact with the type checker and rest of the compiler..
<mrvn> flux: I think the real prolem is this:
<mrvn> # module A : sig val x : int end = struct let x = 1 let y = 2 end;;
<mrvn> module A : sig val x : int end
<mrvn> # module type B = sig include A end;;
<mrvn> Error: Unbound module type A
<mrvn> # module type A = sig val x : int end;;
<mrvn> module type A = sig val x : int end
<mrvn> # module type B = sig include A end;;
<mrvn> module type B = sig val x : int end
<mrvn> Why doesn't the first work?
<flux> because there is no module type A?-)
<flux> btw, can _module_ A be referred after you define module type A?
<flux> hm, apparently it can
<flux> so each time a module was defined so that a matching module type doesn't exist, the module type would be defined automatically?
<mrvn> Why imodule type A = sig val y : int end
<mrvn> # A.x;;
<mrvn> - : int = 1
<mrvn> They are completly independent it seems.
<mrvn> -Why i
<flux> perhaps that isn't sufficiently good solution for some, because it would seem (without looking at the source) to be quite simple to implement
<mrvn> foo.cmi should define the type too
<mrvn> I think that is the part you currently can't do at all.
<mrvn> flux: How do you include a module from another subdir? Anything other than -I subdir?
<flux> mrvn, that's the way
<mrvn> I guess I will use module Lowlevel = struct include Fuse_lowlevel end then instead of Fuse/Lowlevel
itewsh has quit [Read error: 110 (Connection timed out)]
itewsh has joined #ocaml
Lomono has joined #ocaml
travisbrady has joined #ocaml
Lomono has quit ["Don't even think about saying Candlejack or else you wi"]
Lomono has joined #ocaml
Axioplase has quit ["/quat"]
jm has quit [Read error: 110 (Connection timed out)]
jm has joined #ocaml
_zack has quit ["Leaving."]
<det> mrvn, ping
<mrvn> pong
<det> Hi :-)
<det> I made a couple format examples without currying
<det> I pasted links to you, but it seem I always catch you when you are afk
<det> My first attempt
<det> nicer version, about the same syntactic overhead as your version
willb has joined #ocaml
<det> It uses SML instead of Ocaml, because ocaml cant declare infix datatype constructors (for pattern matching)
BrianRice has joined #ocaml
<mrvn> det: I guess that works too. Much less readable type though.
ikaros has quit [Read error: 110 (Connection timed out)]
<det> well, if SML/NJ or whatever compiler used the infix constructors for the type it would be just as readable IMO
bluestorm has quit [Read error: 110 (Connection timed out)]
<det> - format(int % str % nl % str);;
<det> val it = fn : (int,(string,(string,unit) pair) pair) pair -> string
<det> could be "int $ string $ string $ unit -> string"
<det> also, is it possible to abstract the concatenation out of the formatters in the curried version, like I have done in the second version?
olegfink has quit [Remote closed the connection]
jm has quit [Read error: 60 (Operation timed out)]
itewsh has quit [Success]
itewsh has joined #ocaml
barismetin has quit [Read error: 110 (Connection timed out)]
Lomono has quit ["Don't even think about saying Candlejack or else you wi"]
jonafan_ is now known as jonafan
jm has joined #ocaml
sporkmonger has joined #ocaml
itewsh has quit [Read error: 60 (Operation timed out)]
itewsh has joined #ocaml
LeCamarade is now known as LeCamarade|Away
rwmjones is now known as rwmjones_afk
OChameau has quit [Read error: 113 (No route to host)]
Yoric[DT] has joined #ocaml
LeCamarade|Away is now known as LeCamarade
LeCamarade is now known as LeCamarade|Away
rwmjones has joined #ocaml
rwmjones has quit [Client Quit]
rwmjones has joined #ocaml
Amorphous has quit [Read error: 110 (Connection timed out)]
itewsh has quit [Connection timed out]
itewsh has joined #ocaml
Amorphous has joined #ocaml
malc_ has joined #ocaml
eydaimon has left #ocaml []
ikaros has joined #ocaml
itewsh has quit [Success]
itewsh has joined #ocaml
iago has joined #ocaml
itewsh has quit [Connection timed out]
itewsh has joined #ocaml
jm has quit [Read error: 110 (Connection timed out)]
lanaer has quit [Read error: 113 (No route to host)]
jm has joined #ocaml
barismetin has joined #ocaml
smimou has joined #ocaml
travisbrady has quit [Read error: 104 (Connection reset by peer)]
travisbrady has joined #ocaml
itewsh has quit [Read error: 60 (Operation timed out)]
itewsh has joined #ocaml
ikaros has quit [Read error: 113 (No route to host)]
ikaros has joined #ocaml
psnively has quit []
jeanbon has quit [K-lined]
<palomer> hrmph
barismetin has quit [Remote closed the connection]
jm has quit [Read error: 110 (Connection timed out)]
<palomer> anyone ever heard of the "nat" type?
<palomer> it's in pa_sexplib
<palomer> never heard of it
<palomer> supposedly in module Nat
<palomer> and Ratio
jm has joined #ocaml
<Camarade_Tux> module Nativeint iirc
<palomer> Camarade_Tux, got time? I'd like to debug the input problem
<Camarade_Tux> (or maybe Num)
<Camarade_Tux> palomer, no, I have an exam on tomorrow
<Camarade_Tux> tomorrow afternoon/night should be ok however (once I've sorted my 'procuration')
<palomer> kay!
Associat0r has quit []
ikaros_ has joined #ocaml
jmou has joined #ocaml
iZZy_ has joined #ocaml
ikaros_ has quit [Read error: 60 (Operation timed out)]
itewsh has quit [Read error: 110 (Connection timed out)]
jm has quit [Connection timed out]
itewsh has joined #ocaml
ikaros has quit [Read error: 110 (Connection timed out)]
Alpounet has quit ["Quitte"]
jmou is now known as julm
smimou has quit [Read error: 104 (Connection reset by peer)]
jeanbon has joined #ocaml
schme has joined #ocaml
smimou has joined #ocaml
_andre has quit ["*puff*"]
Camarade_Tux has quit ["Leaving"]
ikaros_ has joined #ocaml
lanaer has joined #ocaml
Ched has quit [Read error: 104 (Connection reset by peer)]
rAphael_ has quit ["so looong"]
Ched has joined #ocaml
iZZy_ has quit [Read error: 113 (No route to host)]
itewsh has quit [Success]
itewsh has joined #ocaml
hkBst has quit [Read error: 104 (Connection reset by peer)]
slash_ has joined #ocaml
itewsh has quit [Read error: 60 (Operation timed out)]
itewsh has joined #ocaml
jamii has joined #ocaml
itewsh has quit [Client Quit]
ikaros_ has quit [Read error: 110 (Connection timed out)]
ikaros has joined #ocaml
ulfdoz has quit [Read error: 60 (Operation timed out)]
schme has quit [Read error: 113 (No route to host)]
ergodick has joined #ocaml
ergodick has left #ocaml []
ikaros has quit ["Leave the magic to Houdini"]
jeanb-- has joined #ocaml
jeanbon has quit [Nick collision from services.]
jeanb-- is now known as jeanbon
_zack has joined #ocaml
sgnb` is now known as sgnb
bombshelter13_ has quit []
julm has quit [Read error: 60 (Operation timed out)]
julm has joined #ocaml
_zack has quit ["Leaving."]
<travisbrady> Anyone know why "this code blows up when they try to read a file with more than 30,000 lines"? from Section 8 at http://enfranchisedmind.com/blog/posts/why-ocaml-sucks/
<mrvn> travisbrady: because it is not tail recursive
<travisbrady> ahh, ok, no big deal then
<travisbrady> i wasn't sure if input were crippled in some way
kaustuv_ has joined #ocaml
<mrvn> If the optimizer knew that "List.rev" can not raise End_of_file then it could optimize that away.
kaustuv has quit [Read error: 104 (Connection reset by peer)]
m3ga has joined #ocaml
malc_ has quit ["leaving"]
angerman has quit []
jeanbon has quit ["EOF"]
_JFT_ has joined #ocaml
willb has quit [Read error: 110 (Connection timed out)]
smimou has quit ["bli"]
komar_ has quit [Read error: 113 (No route to host)]
Komar_ has joined #ocaml
Yoric[DT] has quit ["Ex-Chat"]
alexyk has joined #ocaml
slash_ has quit [Client Quit]
seafood has joined #ocaml
alexyk has quit []
_JFT_ has quit []