<metasyntax>
Why does it not signal an error for "if i > max"? It seems as if it should be able to tell there that i : int and max : float.
iratsu has joined #ocaml
mfp has joined #ocaml
zaz\ has joined #ocaml
joewilliams_away is now known as joewilliams
<elehack>
metasyntax: the floor function returns an int, I believe.
<elehack>
or maybe not.
<elehack>
ok, you are getting an error.
<elehack>
new explanation. the OCaml type checker is based on unification (like Prolog evaluation). It keeps unifying types, and throws an error wherever it gets stuck.
<elehack>
so the place in which it catches the error doesn't always make sense.
<elehack>
if it is type-inferring the function and then checking it against the signature, that would be sufficient to produce the error in the location where you are seeing it.
* elehack
is not 100% sure though
<metasyntax>
Hm, that makes sense. I guess I assumed it would start with the signature and "work down" but maybe it infers first and then checks the signature.
neorab has quit [Quit: WeeChat 0.3.2]
joewilliams is now known as joewilliams_away
<metasyntax>
(How) Can I use the same pretty-printer that the toplevel uses for printing some value? So for example, when I do something like "zip [1;2;3] [4;5;6]" in the toplevel I get "- : (int * int) list = [(1, 4); (2, 5); (3, 6)]".
<metasyntax>
If possible I'd like to print that when running the bytecode file with ocamlrun. Do I have to define my own formatter, or is it possible to obtain the one used by the toplevel... and if so, how? :-)
<elehack>
that's a good question. I don't know. It has to have some run-time information about the types, so it can't be as straightforward as calling it.
<elehack>
the compiler would have to generate a formatting function for the particular type you're formatting.
<elehack>
I am not aware of any package that can use the toplevel formatting code to do that, although such a package would be very interesting.
* metasyntax
lacks the wisdom/power/know-how to do it at the moment :-)
joewilliams_away is now known as joewilliams
<metasyntax>
But I might take a look-see at the toplevel to see how it works.
chee has joined #ocaml
<metasyntax>
OK, so not having written any Caml in a few years, and even then I didn't write very much of it, I'm hitting this pattern of composing functions; is there a builtin operator to do that?
<metasyntax>
I've found several threads on the mailing list, but most of them are pretty old (e.g. 1998).
<chee>
pattern of composing functions
<metasyntax>
For example, if I've got odd : int -> bool and I want to get the even numbers in a list, I compose as in (not . odd) : int -> bool and use that as the argument to List.filter.
<metasyntax>
The solution I usually see is to do: let ($) f g x = f (g x) -- using whatever your favorite not-already-taken symbol is for the $ where desired. I was curious if that's really the way it's got to be, or if OCaml has a reserved symbol for this already, like Haskell uses the period for example.
<chee>
I am not going to be able to answer your question because I started learning OCaml around 52 hours ago.
<metasyntax>
haha, OK fair enough! :-D
<chee>
I hoped if I got you expand on it a little perhaps somebody in here would answer
caligula_ has joined #ocaml
caligula__ has quit [Ping timeout: 248 seconds]
joewilliams is now known as joewilliams_away
aja has joined #ocaml
<thelema>
metasyntax: on typechecking - the given signature is checked *last*, as a total afterthought to actual typechecking.
<thelema>
metasyntax: no builtin operator to compose functions, but it's really easy to do. You have to use a wierd symbol to get proper precedence and associativity, batteries included uses (**>)
jakedouglas has joined #ocaml
ulfdoz has joined #ocaml
thelema has quit [Remote host closed the connection]
thelema has joined #ocaml
coucou747 has joined #ocaml
coucou747 has quit [Ping timeout: 276 seconds]
ulfdoz_ has joined #ocaml
<chee>
hey, so I've only been using ocaml for a little while now and it's my first real exploration into a language with such a pure functional paradigm, and I'm having a little bit of trouble thinking
<thelema>
what's the problem
<chee>
I've written quite a few little things so far, function to calculate length of list, sum of list, max of list, search through binary trees
<chee>
well, thelema. I'm trying to write a little look and say sequence generator
<chee>
and I'm having trouble doing it without variables
<thelema>
if variables are appropriate, use them.
<thelema>
ocaml isn't too dogmatic.
ulfdoz has quit [Ping timeout: 240 seconds]
ulfdoz_ has quit [Client Quit]
ulfdoz has joined #ocaml
<chee>
well, i don't really know how! also, I'm not sure if they are necessary
<chee>
I think the steps are: 1. You look at the next number, you check if it's the same as the number you got last time. 2a. if so, add one to the count for that number. 2b. if not, add count and number to the new list, head becomes the new number, count is reset. recurse until []
<chee>
but I tried figuring it out forever before I almost suicided
<flux>
so you are trying to generate for example list [0; 1; 2; 3; 4] ?
<chee>
flux: if the list I am working with is [1;1] the list i should come away with is [2;1] then [1;2;1;1]
<chee>
they work like this, you start with 1
<chee>
1 is one one, or 11
<chee>
11 is two ones, or 21
<thelema>
for that you just need recursion...
<chee>
21 is one two, one one or 1211. 1211 is one one, one two, two ones. or 111221
<chee>
and so it goes on
<chee>
indefinately
<chee>
thelema: this is what i thought. i just need some help thinking about the problem, i bleev.
<thelema>
and you're trying to write the function that does one step of that sequence
<chee>
thelema: yes. just one step at the moment
<flux>
hmm.. so you need to know the number of consecutive repeats of a single number, put that number down, and then the original number? like RLE compression?
<thelema>
ok, each time you look at the next number in the list, you need to know the last digit [n] and how many times it appeared [k]
<chee>
flux: yes! in fact RLE is closely related to the look-and-say sequence/cuckoo's egg
<chee>
thelema: yes
<thelema>
let rec loop n k lst =
<thelema>
...
<chee>
the very top line I had started with, but with different variable names
<thelema>
let look_say h::t = loop h 1 t
<thelema>
ok, let's decompose lst in loop, what are the three cases?
<chee>
[], hd :: tl when hd = n and any other hd :: tl
<chee>
?
<thelema>
yup
<thelema>
what do you return if []?
<chee>
I am not sure. it's going to be returnning a list overall, isn't it.. so
<chee>
[] -> [] ?
<thelema>
no, what about n and k?
<chee>
they are ints. which is what we're going be returning.
<thelema>
[] -> [n;k]
<chee>
of course.
<thelema>
case 2?
<chee>
| a :: d when a = n -> loop a (n + 1) d
<thelema>
and case 3?
<thelema>
well, almost
Yoric has joined #ocaml
<chee>
| a :: d -> loop a 1 d
<thelema>
loop a (k+1) d
<thelema>
and no on case 3
<chee>
oh yes, k+1
<chee>
why no on case 3
<thelema>
same reason [] -> [] is wrong
<chee>
I need to do something with my current n and k
<thelema>
yes
<chee>
put them somewhere
<thelema>
on the returned list
<chee>
!
<thelema>
got it?
<chee>
no!
<thelema>
how do you compute length of a list?
<thelema>
the recursive case
<chee>
| _ :: t -> 1 + llen t
<thelema>
yup. something similar here
<chee>
| a :: d -> n :: k :: loop a 1 d ?
<thelema>
looks good to me, try that
<chee>
:D
<chee>
oops, k :: n ::
<thelema>
yes, of course
<chee>
hm, something's not quite right !
<thelema>
compiles?
<chee>
yes perfectly :D
<chee>
ty
<chee>
however!
<thelema>
runs bad?
<chee>
let cuckoo (a :: d) = loop a 1 d;;
<chee>
that's how I should write the main line, is it?
<thelema>
yes, that'll give a warning, and will fail for an empty list
<chee>
thelema: for some reason it is giving me the result in reverse, I think
<thelema>
12 -> 1211?
<chee>
no, not even that. I think each of the runs is in reverse
<thelema>
example?
<chee>
hm! on further reflection it is only the -- oh
<chee>
lol!
<chee>
| [] -> [n;k]
<thelema>
k n
<chee>
haha ;D
<chee>
cuckoo [1; 1; 2; 3;] => [2; 1; 1; 2; 3; 1]
<chee>
:D:D!
<chee>
thankyou thelema
<thelema>
you're welcome. now your job is to make it tail recursive...
<chee>
:D I don't think I know what what that means
coucou747 has joined #ocaml
<thelema>
don't worry then. it's a way to optimize recursion for performance
<thelema>
and scalability
<chee>
I am reading about it now in the DADS
philed has joined #ocaml
Amorphous has quit [Ping timeout: 248 seconds]
aja has quit [Read error: Connection reset by peer]
ulfdoz has quit [Ping timeout: 248 seconds]
mal``` has joined #ocaml
mal`` has quit [Read error: Connection reset by peer]
_unK has quit [Remote host closed the connection]
Amorphous has joined #ocaml
ygrek has joined #ocaml
Yoric has quit [Quit: Yoric]
Yoric has joined #ocaml
Yoric has quit [Client Quit]
Yoric has joined #ocaml
ftrvxmtrx has quit [Quit: Leaving]
jakedouglas has quit [Quit: Leaving.]
Associat0r has joined #ocaml
Yoric has quit [Quit: Yoric]
ygrek has quit [Ping timeout: 245 seconds]
coucou747 has quit [Ping timeout: 260 seconds]
ttamttam has joined #ocaml
ftrvxmtrx has joined #ocaml
<flux>
there are other ways to implement it as well, and I might've picked one of those :)
<flux>
for example with the help of function val sequence_length : 'a -> 'a list -> (int * 'a list)
Yoric has joined #ocaml
ttamttam has left #ocaml []
valross has quit [Quit: Ex-Chat]
ikaros has joined #ocaml
ttamttam has joined #ocaml
verte has joined #ocaml
ttamttam has quit [Remote host closed the connection]
ttamttam has joined #ocaml
Yoric_ has joined #ocaml
Yoric has quit [Ping timeout: 240 seconds]
Yoric_ is now known as Yoric
LionMadeOfLions has quit [Ping timeout: 260 seconds]
LionMadeOfLions has joined #ocaml
<adrien>
\o/ new camomile release
verte has quit [Quit: ~~~ Crash in JIT!]
ikaros_ has joined #ocaml
ikaros has quit [Ping timeout: 245 seconds]
ikaros_ has quit [Quit: Leave the magic to Houdini]
Yoric_ has joined #ocaml
Yoric has quit [Read error: Connection reset by peer]
Yoric_ is now known as Yoric
ikaros has joined #ocaml
ikaros has quit [Read error: Connection reset by peer]
Yoric has quit [Read error: Connection reset by peer]
Yoric has joined #ocaml
Associat0r has quit [Quit: Associat0r]
verte has joined #ocaml
ikaros has joined #ocaml
Associat0r has joined #ocaml
Yoric has quit [Read error: Connection reset by peer]
Yoric has joined #ocaml
ikaros has quit [Quit: Leave the magic to Houdini]
iratsu has quit [Ping timeout: 240 seconds]
iratsu has joined #ocaml
ikaros has joined #ocaml
Yoric has quit [Quit: Yoric]
ygrek has joined #ocaml
avsm has joined #ocaml
iratsu has quit [Ping timeout: 276 seconds]
iratsu has joined #ocaml
sgnb has quit [Ping timeout: 252 seconds]
sgnb has joined #ocaml
iratsu has quit [Ping timeout: 240 seconds]
iratsu has joined #ocaml
ygrek has quit [Ping timeout: 245 seconds]
sepp2k has joined #ocaml
derdon has joined #ocaml
ztfw has quit [Remote host closed the connection]
srcerer has quit [Quit: ChatZilla 0.9.86 [Firefox 3.6.4/20100611143157]]
sdschulz` has joined #ocaml
sdschulze has quit [Ping timeout: 240 seconds]
chee has quit [Ping timeout: 245 seconds]
chee has joined #ocaml
Associat0r has quit [Read error: Connection reset by peer]
itewsh has joined #ocaml
verte has quit [Quit: ~~~ Crash in JIT!]
<philed>
If I have an 'a list and I cons on something of type 'b, is the type of the result a 'c list where 'c is the meet of 'a and 'b?
ccasin has joined #ocaml
<hcarty>
philed: You can't add a 'b value on an 'a list
<hcarty>
Unless I'm misunderstanding the question
<hcarty>
thelema: Do you know if someone is going to/has taken over upkeep of Camomile in GODI?
<hcarty>
thelema: The current listed maintainer is David Teller
<philed>
In this case, I'm assuming that 'a and 'b are record types.
seafood has quit [Quit: seafood]
derdon has left #ocaml []
<philed>
So I've got foo a = a#x and bar a = a#y. And I can cons foo onto [bar]. I'd assumed that was impossible.
oriba has joined #ocaml
<f[x]>
foo and bar are functions, if this is full code they'll get unified to common type ('a -> 'b) and everything is ok
<philed>
f[x]: Ah, okay. So is the toplevel misleading me at the moment. It says that foo and bar have different types.
f[x] has left #ocaml []
f[x] has joined #ocaml
<philed>
foo has type < a : 'a; .. > -> 'a. bar has type < b : 'a; .. > -> 'a. And [foo;bar] has type (<a : 'a; b : 'a; .. > -> 'a) list
<f[x]>
different but unifiable
<philed>
Okay, cool. So am I not supposed to be thinking about this in terms of subtyping?
<f[x]>
after consing and unification each type gets more "constraints"
<f[x]>
not sure about subtyping
<philed>
f[x]: Okay, cheers for the help. I'm only just starting to delve into ocaml objects, and I still haven't got the separation between row-polymorphism and subtyping clear in my head yet :) Whatever the case, it seems that Ocaml is going to let me do what I want it to do!
* f[x]
doesn't grok it fully from the theoretical pov
<hcarty>
krankkatze: Or open Batteries_uni instead of Batteries
oriba has joined #ocaml
<krankkatze>
and it looks like it allready uses -linkpkg
ygrek has joined #ocaml
<hcarty>
krankkatze: Batteries comes with a myocamlbuild.ml which does a lot of this for you automatically.
<krankkatze>
(oh, and I have "<cgi.ml>: pkg_batteries" in my _tags)
<krankkatze>
hcarty: what do you mean?
sepp2k1 has joined #ocaml
<hcarty>
krankkatze: Batteries has a myocamlbuild.ml in its source distribution which provides working ocamlfind support, among other things
<hcarty>
It doesn't require Batteries to use, but it is very handy
<krankkatze>
so I just have to copy it in my project directory, keep my _tags and use ocamlbuild ?
<sgnb>
(btw, there is some findlib subpport in 3.12's ocamlbuild...)
<hcarty>
Yes
<hcarty>
sgnb: I'm looking forward to that. Hopefully it works well.
sepp2k has quit [Ping timeout: 245 seconds]
<flux>
sgnb, oooh
<flux>
that's.. like.. official blessing of findlib!
<flux>
how surprisingly pragmatic ;)
<hcarty>
krankkatze: The Batteries module also requires threading support. If you use the Batteries_uni module instead of Batteries then you can avoid having to link with the OCaml threading library.
<hcarty>
flux: Perhaps it's just a prank
<krankkatze>
hcarty: I'm having the same error when using the following myocamlbuild.ml
<hcarty>
Oh! I see what is (hopefully) the problem
<hcarty>
krankkatze: You want "<cgi.*>: pkg_batteries" in _tags
<krankkatze>
oh
<hcarty>
You may be able to be more specific in that, but ocamlbuild needs to know that Batteries is needed in linking as well (IIRC)
<krankkatze>
ls
<krankkatze>
sry
<krankkatze>
hm
<krankkatze>
I'm getting a new, pretty strange error
<krankkatze>
hmm
<krankkatze>
and now, the same again :D
patronus has quit [Read error: Connection reset by peer]
patronus has joined #ocaml
oriba has quit [Read error: Connection reset by peer]
<hcarty>
krankkatze: Are there other source files involved?
<hcarty>
krankkatze: Also, you still need the pkg_threads - sorry, I wasn't clear on that earlier
<krankkatze>
there are 3 source files
<krankkatze>
and I"ve already put pkg_threads
<krankkatze>
in the _tags
<hcarty>
They all need those tags if they all use Batteries
<krankkatze>
well
<krankkatze>
oh ok
<krankkatze>
that was the problem
<krankkatze>
I'm really sorry for making you lose your time with this :?
<krankkatze>
:/
<hcarty>
krankkatze: It's ok, I'm glad you got it working
<hcarty>
I wouldn't know what I know without the assistance from others in #ocaml
oriba has joined #ocaml
<rwmjones>
any coccinelle experts around? I have a really simple q but I can't work out how to do it:
<rwmjones>
rename all the public functions in a C program which match foo_X to bar_X (for all X)
<adrien>
rwmjones: I think lwn.net has an example for that
<rwmjones>
I read those two articles, but I couldn't see anything like that
<rwmjones>
nothing in the examples either
<rwmjones>
I can rename foo -> bar by doing
<rwmjones>
- foo
<rwmjones>
+ bar
<adrien>
-foo_X(E)
<rwmjones>
but what I want to do is rename classes of functions
<adrien>
+bar_X(E)
<rwmjones>
is X a wildcard??
<adrien>
ah, ok
* rwmjones
tries
<adrien>
no, I don't think it is
thieusoai has joined #ocaml
<adrien>
in doubt, I'd make sure everything is tracked by a VCS, use sed and use the vcs' functionnality to get and check the changes
chee has quit [Ping timeout: 265 seconds]
chee has joined #ocaml
ftrvxmtrx has joined #ocaml
chee has quit [Read error: Connection reset by peer]
chee has joined #ocaml
alexyk has joined #ocaml
<alexyk>
I have a nested Hashtbl type and want to compute the total length of lowest-level Hashtbl's summed up over all the intermediate levels. I decided to add a level parameter to recurse or terminate, but it won't compile: why? http://paste.pocoo.org/show/235157/
ikaros has quit [Quit: Leave the magic to Houdini]
<alexyk>
how do you pattern-match a Hashtbl?
<alexyk>
i.e. if something is a Hashtbl?
<alexyk>
and perhaps of a certain kind (nested or not)?