gildor changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | OCaml 3.12.1 http://bit.ly/nNVIVH
technomancy` has joined #ocaml
robert_randolph has joined #ocaml
<robert_randolph> what would be the type signature for a 2d array of integers?
<thelema> robert_randolph: int array array
<robert_randolph> thelema, thank you
technomancy` has quit [Quit: ERC Version 5.3 (IRC client for Emacs)]
sebz has joined #ocaml
joewilliams_away is now known as joewilliams
seafood_ has quit [Ping timeout: 260 seconds]
seafood_ has joined #ocaml
Boscop has left #ocaml []
sebz has quit [Quit: Computer has gone to sleep.]
mdelaney has quit [Quit: mdelaney]
lopex has quit []
dgbaley27 has joined #ocaml
<dgbaley27> I'm having trouble understanding how to add some output in a function. I have "let rec foo (c: MyClass) = match c with ..." and I want to slide a print_string before the match. Is this possible?
<dgbaley27> Do newlines affect it?
surikator has quit [Quit: Scientific discovery is just maximal compression of random strings. Nothing more, nothing less.]
<NaCl> dgbaley27: something like let rec foo c = print_endline "some string" ; match c with ...
<dgbaley27> Ok, so a single semicolon?
<NaCl> yeah
<NaCl> that specifies an imperative statement
<dgbaley27> And do newlines and indentation affect the parsing?
<NaCl> IIRC no
<NaCl> yeah, no
<dgbaley27> ty
<dgbaley27> What about this: Inside a match I have "let n0 = foo 1 in // let n1 = foo 2 in // n0 = n1" Are the "in"s necessary?
<dgbaley27> How can I do without them?
iratsu has joined #ocaml
<thelema> let n0 = foo 1 and n1 = foo 2 in n0 = n1
<thelema> dgbaley27: but it's better to use the in's
<dgbaley27> Well, that still does use "in". Do you mean it's better to have both of them?
<thelema> yes.
<thelema> unless foo 1 and foo 2 are short, in which case you can do foo 1 = foo 2
iratsu has quit [Ping timeout: 245 seconds]
mdelaney has joined #ocaml
joewilliams is now known as joewilliams_away
iratsu has joined #ocaml
mdelaney has quit [Quit: mdelaney]
<dgbaley27> Just for clarity, how come I couldn't do ""let n0 = foo 1;; // let n1 = foo 2;; // n0 = n1"?
arubin has quit [Quit: arubin]
<robert_randolph> how would i write a "switch" statement for a range of values for some variable?
<robert_randolph> say for example 2 < x < 4 and 4 < x < 6
<thelema> robert_randolph: match foo x with | x when x <= 2 -> ... | x when x > 2 -> ... | x when x > 4 -> ... | x when x > 6 -> ...
<robert_randolph> thelema, thanks again
<thelema> dgbaley27: at the toplevel you can, and in the outermost level of a file, but inside a larger expression, you can't use ;;
<dgbaley27> Is there somewhere in the manual explaining why that is?
<dgbaley27> This is my first functional language so I think I am having a hard time viewing the syntax correctly
<thelema> dgbaley27: a file is composed of phrases, with optional ;; between them
<thelema> a phrase is a single let expression (without in), a module, an object or ... well, even just an expression.
<dgbaley27> So you can't have multiple phrases in a function?
<thelema> but ;; is needed before and after plain expressions, as the boundary can't be found automatically
<dgbaley27> I see
<thelema> correct. a single binding has to be within a single phrase
<thelema> phrases don't go within anything, just directly inside a file.
<robert_randolph> how can i convert a batteries Enum thing to an array or a list?
<thelema> robert_randolph: Array.of_enum or List.of_enum
<robert_randolph> thelema, thanks again!
<robert_randolph> I don't know if I'm a dummy or the documentation is bad
<robert_randolph> ok, now how do I get an array slice? say from a.(x) to a.(y)
<thelema> robert_randolph: no array slices. only Array.sub, which does a copy
<thelema> Array.sub a x (y-x+1)
<thelema> (maybe a is last arg, I forget)
<thelema> There are slices of bigarrays: Bigarray.Array1.sub
<robert_randolph> thanks again. It's array 'a -> int -> int. Too bad it doesn't work nicely with |>
sebz has joined #ocaml
johnnowak has joined #ocaml
<johnnowak> hello all. is there any way to abbreviate module names in a .mli file?
<johnnowak> the only thing i can think to do is "module X = Long_Name" in the implementation and then "module x : module type of Long_Name" in the interface.. which is brutal
explodus has joined #ocaml
dnolen has quit [Quit: dnolen]
sebz has quit [Quit: Computer has gone to sleep.]
jimmyrcom has quit [Ping timeout: 245 seconds]
sebz has joined #ocaml
dnolen has joined #ocaml
dgbaley27 has left #ocaml []
sebz has quit [Quit: Computer has gone to sleep.]
mdelaney has joined #ocaml
ulfdoz has joined #ocaml
mdelaney has quit [Quit: mdelaney]
mdelaney has joined #ocaml
hto has joined #ocaml
hto has quit [Read error: Connection reset by peer]
mdelaney has quit [Quit: mdelaney]
mdelaney has joined #ocaml
hto has joined #ocaml
mdelaney has quit [Ping timeout: 264 seconds]
ulfdoz has quit [Ping timeout: 276 seconds]
junsuijin has quit [Quit: Leaving.]
Snark has joined #ocaml
dnolen has quit [Quit: dnolen]
larhat has joined #ocaml
robert_randolph has quit [Read error: Connection reset by peer]
seafood_ has quit [Quit: seafood_]
mbac has quit [Read error: Connection reset by peer]
betta_y_omega has quit [Read error: Operation timed out]
betta_y_omega has joined #ocaml
betta_y_omega has quit [Excess Flood]
bobry has joined #ocaml
zorun has quit [Quit: leaving]
zorun has joined #ocaml
hyperboreean has quit [Ping timeout: 260 seconds]
hyperboreean has joined #ocaml
rby has quit [Quit: leaving]
hto has quit [Ping timeout: 252 seconds]
iratsu has quit [Ping timeout: 245 seconds]
hto has joined #ocaml
rby has joined #ocaml
Yoric has joined #ocaml
rby has quit [Client Quit]
surikator has joined #ocaml
rby has joined #ocaml
bobry1 has joined #ocaml
<adrien> is there something in the stdlib that would let me check a file is at the root of a filesystem?
<adrien> I want to know that "foo" in "e:\foo", "/mnt/tmp/foo", "/media/foo" is at the root of a filesystem
<flux> adrien, you could use Unix.stat perhaps, and find if a file's st_rdev is the same as the rt_dev for directory one up from it
<flux> (but I don't know how it/if works in windows)
<flux> also binding mounts will confuse it
<adrien> flux: that sounds good, I'm going to try it
<adrien> in the worst case, I'll have a different test for windows (I don't need a perfect test, a heuristic is definitely enough)
<adrien> on windows, looks like st_dev = st_rdev = (Char.code drive_letter) - (Char.code 'a') + 1
Qrntzz has quit [*.net *.split]
jonathandav has quit [*.net *.split]
mcclurmc has quit [*.net *.split]
mehdid has quit [*.net *.split]
foocraft has quit [*.net *.split]
diml has quit [*.net *.split]
fabjan has quit [*.net *.split]
Qrntzz has joined #ocaml
jonathandav has joined #ocaml
mcclurmc has joined #ocaml
mehdid has joined #ocaml
foocraft has joined #ocaml
diml has joined #ocaml
fabjan has joined #ocaml
<flux> for windows you can just look at the name :)
<adrien> yup, works quite well, without even looking at the name
<adrien> actually, maybe I look at it, but it's: file <> Filename.dirname file
jaar has joined #ocaml
ikaros has joined #ocaml
lopex has joined #ocaml
johnnowak has quit [Quit: Leaving.]
betta_y_omega has joined #ocaml
iratsu has joined #ocaml
iratsu has quit [Ping timeout: 245 seconds]
_andre has joined #ocaml
caligula has quit [Ping timeout: 252 seconds]
jimmyrcom has joined #ocaml
milosn has quit [Ping timeout: 264 seconds]
milosn has joined #ocaml
iratsu has joined #ocaml
rby has quit [Quit: Lost terminal]
Yoric has quit [Quit: Leaving.]
eb4890 has joined #ocaml
slecuyer has joined #ocaml
dnolen has joined #ocaml
caligula has joined #ocaml
<thelema> any guesses as to why ocamlc/win64 isn't finding batEnum when it has -I /usr/lib/ocaml/site-lib/batteries/ and there's a file /usr/lib/ocaml/site-lib/batteries/batEnum.cmi ?
ttamttam has joined #ocaml
ttamttam has quit [Client Quit]
<thelema> ah, it's trying to use windows pathnames
<thelema> ocaml wants f:\cygwin\lib\...\batteries
<adrien> forward slashes!
<thelema> yes, those too.
<thelema> I think I may have a working ocaml under win32
<thelema> err, win64
<thelema> and a working findlib too (which seems to expect cygwin-style path handling from ocamlc.exe)
joewilliams_away is now known as joewilliams
iratsu has quit [Ping timeout: 276 seconds]
Yoric has joined #ocaml
surikator has quit [Quit: surikator]
lopex has quit []
iratsu has joined #ocaml
rby has joined #ocaml
<f[x]> thelema, first time using ocaml on windows?
<thelema> first time succeeding
<thelema> the cygwin caml seemed to work easily, but I needed 64-bit ocaml for my program (assumes ints can hold an IP address)
<thelema> *lots* of fun getting ocaml to build on windows. Much of it my own fault.
<ousado> hi all, is it possible to rebind a function locally for a certain expression, so that all functions called from within it use the rebound function instead of the original one?
<thelema> ousado: of course.
<thelema> well, only lexically
<thelema> if you have: let f x = g 1 x, there's no way to patch [f] to call [h] instead of [g]
<thelema> other than changing [f] itself
dnolen has quit [Quit: dnolen]
BiDOrD_ has quit [Read error: Operation timed out]
<thelema> let f x = let g = h in g 1 x
<ousado> oh.. ok. damn
<thelema> just pass the function you want to vary as an argument
<ousado> hm.. I'd have to change every function in this code generator for that..
<ousado> but there's a context object passed around, I think I can use that
<adrien> it's fine, it's a code generator :P
<thelema> or use a reference
<thelema> let f x = !g 1 x
<thelema> g := h
<ousado> hm..
BiDOrD has joined #ocaml
<ousado> yes
<ousado> sounds good
<ousado> ocaml is a nice language
<thelema> yes it is.
<thelema> just the right amount of "dirty" to get things done.
<ousado> hehe
<ousado> yes
<ousado> say that in #haskell :P
<thelema> lol
Associat0r has joined #ocaml
Associat0r has quit [Changing host]
Associat0r has joined #ocaml
jaar has quit [Quit: Quitte]
robert_randolph has joined #ocaml
bobry has quit [Quit: Leaving.]
larhat has quit [Quit: Leaving.]
iratsu has quit [Ping timeout: 260 seconds]
Ori_B_ has joined #ocaml
Ori_B_ has quit [Remote host closed the connection]
Ori_B has joined #ocaml
Ori_B has quit [Client Quit]
Ori_B has joined #ocaml
Ori_B has quit [Client Quit]
Ori_B has joined #ocaml
Ori_B has quit [Client Quit]
Ori_B has joined #ocaml
mdelaney has joined #ocaml
Ori_B has quit [Client Quit]
<thelema> grr, getting ... bus errors ... in my ocaml code
Ori_B has joined #ocaml
<thelema> I'm pretty sure I didn't introduce any Obj.magic
Ori_B has left #ocaml []
Ori_B has joined #ocaml
Ori_B has left #ocaml []
<flux> thelema, lapack was waaaay too generic for my 2d needs. perhaps I should package this simple set of 2d vector operations into a library, I've written the same stuff like a half a dozen times already :)
Associat0r has quit [Quit: Associat0r]
lpereira has joined #ocaml
betta_y_omega has quit [Ping timeout: 260 seconds]
<thelema> flux: true, lapack is *quite* generic. I think I did a bunch of 1d vector shortcuts for my uses.
<flux> 1d vector, like, single values?-)
<thelema> no, 1d vector like 1d array
<thelema> Array1
<thelema> 0d vector would be a single value
lopex has joined #ocaml
<flux> hm, aren't all vectors like Array1, and all matrices like Array2?
<flux> I would rather think the terms '2d vector' and '3d vector' to mean a vector with 2 values and 3 values, respectively :)
<thelema> so what do you mean by 2d vector, if you don't mean ... ah
<thelema> pair and triple.
<thelema> I was thinking about the dimension of a vector as the dimension of a bigarray - the number of indexes that can be applied at once to get a value
<thelema> a vector with 2 values can be used to represent a 2d value, but it's not a 2d vector.
ulfdoz has joined #ocaml
mdelaney has quit [Quit: mdelaney]
mdelaney has joined #ocaml
robert_randolph has quit [Read error: Connection reset by peer]
surikator has joined #ocaml
surikator has quit [Client Quit]
ygrek has joined #ocaml
<thelema> given a list of sets, how to best enumerate the list of values consisting of one value from each set
<slecuyer> ined #ocaml
<slecuyer> 13:34 < thelema> given a list of sets, how to best enumerate the list of values consisting of one value from each set
<slecuyer> sorry, I accidentally clicked/dragged through the window
<thelema> http://pastebin.com/PZCtVrur L4-7 is my solution, but it seems to use exponential space
<thelema> hmm, apparently it's not the thing that uses exponential space, but rather the construction of sets.
junsuijin has joined #ocaml
johnnowak has joined #ocaml
johnnowak has quit [Client Quit]
Snark has quit [Quit: Quitte]
sebz has joined #ocaml
sebz has quit [Quit: Computer has gone to sleep.]
ikaros has quit [Quit: Ex-Chat]
_andre has quit [Quit: leaving]
sebz has joined #ocaml
lpereira has quit [Quit: Leaving.]
sebz has quit [Client Quit]
mdelaney is now known as mdelaney-afk
sebz has joined #ocaml
ygrek has quit [Quit: Leaving]
eb4890 has quit [Ping timeout: 260 seconds]
oriba has joined #ocaml
Kevin_ has joined #ocaml
<Kevin_> hello
<thelema> hi
<Kevin_> Hey thelema, I'm looking for some super beginner ocaml help
<Kevin_> this a good place to ask a question?
<thelema> yes
<Kevin_> so i'm looking at a function that takes a tuple and returns just the first value
<Kevin_> let first p = let (x,y) = p in x;;
<thelema> let f (x,_) = x
<Kevin_> and i'm having trouble conceptually understanding this
<Kevin_> or rather why that actually works
<thelema> is your problem the "let (x,y) = p"?
<Kevin_> yeah
<Kevin_> lol
<thelema> the compiler knows that p has to be a pair for this to work.
<Kevin_> so the compiler understands that without me explicitly stating it?
<thelema> and it can give labels to each component, x and y
<thelema> yes. It is implicit in "let (x,y) = p" -- the type of (x,y) [('a * 'b)] has to be the same as the type of p. Thus p is a pair.
<Kevin_> so its similar to typing
<Kevin_> let (x,y) = 1,3;;
<Kevin_> in the sense that a tuple is being assigned
<thelema> let p = (1,3) in let (x,y) = p
<Kevin_> to a tuple
<Kevin_> yes ok
<thelema> not quite assignment as in other languages. Just the giving of names to things.
<Kevin_> ok fair enough
<Kevin_> so the "in x" then
<thelema> if p isn't a tuple, you'll get an error somewhere.
<thelema> let x = 5 in x*2
<Kevin_> so let x = 2 in x;;
<thelema> "in" just ends the let binding. any values bound on the left-hand-side are accessible after the binding
<thelema> x is the expression to return.
<Kevin_> got it
<Kevin_> so the whole thing then is
<thelema> "let x = 2 in x" is just a funny way of saying "2"
<Kevin_> let the function 'first' with parameter p where p is a tuple return the x in the x,y pair
<thelema> sure.
<thelema> or another way to write it in ocaml:
<thelema> let first p = match p with (x,y) -> x
<Kevin_> that seems much easier intuitively
<thelema> since there's only one way to do the matching, "match p with (x,y) -> " is the same as "let (x,y) = p in"
<Kevin_> ok i think you've given me enough to chew on, makes it much clearer, thank you
Yoric has quit [Quit: Leaving.]
slecuyer has quit [Ping timeout: 264 seconds]
Morphous has quit [Ping timeout: 276 seconds]
Morphous has joined #ocaml
sebz has quit [Quit: Computer has gone to sleep.]
sebz has joined #ocaml
iratsu has joined #ocaml
mdelaney-afk is now known as mdelaney
oriba has quit [Remote host closed the connection]
avsm has joined #ocaml
mdelaney has quit [Ping timeout: 260 seconds]
rgrinberg has joined #ocaml
rgrinberg has quit [Remote host closed the connection]
rgrinberg has joined #ocaml
mdelaney has joined #ocaml
avsm has quit [Quit: Leaving.]
surikator has joined #ocaml
dnolen has joined #ocaml
sebz has quit [Quit: Computer has gone to sleep.]
sebz has joined #ocaml
lecuyer has joined #ocaml
mdelaney has quit [Quit: mdelaney]
arubin has joined #ocaml
mdelaney_ has joined #ocaml
mdelaney_ has quit [Client Quit]
mdelaney has joined #ocaml
<lecuyer> I know this may seem like sort of a silly syntax question, but if I have a type defined as a pair of strings, how do I use fst and snd on it?
mdelaney has quit [Client Quit]
<dsheets> lecuyer: you have type sp = string * string ?
<surikator> # fst ("foo","bar");;
<surikator> - : string = "foo"
<dsheets> lecuyer: fst : 'a * 'b -> 'a
<surikator> # snd ("foo","bar");;
<surikator> - : string = "bar"
<lecuyer> yes, I have type foo = string * string;;
<lecuyer> well, type foo = Bar of string * string;;
<surikator> lecuyer: just write ---- fst ("blah", "plah");;
<surikator> it will give you "blah"
<surikator> and snd("blah","plah") will give you "plah"
<lecuyer> and then I have a foo list