ulfdoz has quit [Read error: 104 (Connection reset by peer)]
r0bby has joined #ocaml
m4rk has joined #ocaml
ulfdoz_ has quit [Remote closed the connection]
ulfdoz has joined #ocaml
sporkmonger has joined #ocaml
m4rk has quit ["Lost terminal"]
vpalle has quit [Read error: 60 (Operation timed out)]
vpalle has joined #ocaml
sporkmonger has quit []
slash_ has quit ["leaving"]
vpalle has quit ["Leaving"]
jeddhaberstro has joined #ocaml
sporkmonger has joined #ocaml
Amorphous has quit [Read error: 113 (No route to host)]
Amorphous has joined #ocaml
hsuh has joined #ocaml
<hsuh>
hm. can i drwa using Graphics without popping up a windows ?
<hsuh>
s/windows/window
seafood_ has joined #ocaml
ched has quit [Read error: 110 (Connection timed out)]
ched has joined #ocaml
seafood has quit [Read error: 110 (Connection timed out)]
seafood_ has quit []
hsuh has quit [Remote closed the connection]
jeddhaberstro has quit []
astronut has joined #ocaml
<astronut>
does '::' have an equivelent function?
<astronut>
List.prepend?
<thelema>
List.cons (in batteries), (fun x l -> x :: l)
AxleLonghorn has joined #ocaml
vuln has joined #ocaml
ulfdoz has quit [Read error: 110 (Connection timed out)]
Axioplase has joined #ocaml
<kaustuv>
Reading the ocaml source, apparently this also works: (fun x l -> (::)(x, l)). I had no idea (::)(_, _) was a valid expression constructor.
<astronut>
thelema: never mind, i got what i needed, but thanks
<astronut>
kaustuv: thanks, that's cool
sporkmonger has quit []
alexlmj has joined #ocaml
ttamttam has joined #ocaml
ulfdoz has joined #ocaml
ttamttam has left #ocaml []
<AxleLonghorn>
working with modules and functors is difficult. I keep wanting them to behave like runtime objects.
alexlmj has quit ["ChatZilla 0.9.84 [Iceweasel 3.0.6/2009020409]"]
alexlmj has joined #ocaml
alexlmj has quit [Client Quit]
vuln has quit ["leaving"]
AxleLonghorn has left #ocaml []
<Axioplase>
weird. let f x = (::) x;; gives a syntax error. I never though of :: as a constructor (for I consider lists as builtin, rather than an explicit datatype)
<Axioplase>
(So, it's not weird, and it does completely make sense)
<Axioplase>
I only miss partial application of constructors…
<kaustuv>
:: is explicitly allowed as a constructor in the grammar
<kaustuv>
type t = :: of int ;;
<kaustuv>
And exactly the syntactic form LPAREN COLONCOLON RPAREN LPAREN exp COMMA exp RPAREN is an expression.
<kaustuv>
So, in particular, type t = :: of int * int * int;; let x = (::)(10,20,30);; won't work.
<kaustuv>
It's a pity [] is not a constructor too, or we could almost redefine lists, eg. make them lazy by default.
<kaustuv>
Best we can do now is:
<kaustuv>
type 'a lazylist = Nil | :: of 'a * 'a lazylist Lazy.t ;;
<kaustuv>
let ltl = function Nil -> invalid_arg "ltl" | _ :: lazy xs -> xs ;;
Cheshire has joined #ocaml
yziquel has joined #ocaml
_zack has joined #ocaml
yziquel has quit [Remote closed the connection]
ikaros has joined #ocaml
Cheshire has quit ["This computer has gone to sleep"]
ttamttam has joined #ocaml
_zack has quit ["Leaving."]
s4tan has joined #ocaml
ikaros_ has joined #ocaml
kelaouchi has quit [Read error: 60 (Operation timed out)]
ikaros has quit [Read error: 110 (Connection timed out)]
ikaros has joined #ocaml
_zack has joined #ocaml
Cheshire has joined #ocaml
ikaros_ has quit [Read error: 110 (Connection timed out)]
hkBst has joined #ocaml
ikaros has quit [".quit"]
pixel_ has quit ["leaving"]
pixel_ has joined #ocaml
pixel_ has quit [Client Quit]
pixel_ has joined #ocaml
tripwyre has joined #ocaml
totom has joined #ocaml
<totom>
hi
<totom>
could someone tell me what this means :
<totom>
Values do not match:
<totom>
val makeTuple : (Relational.Tuple.key * '_a) list -> '_a Relational.Tuple.t
<totom>
is not included in
<totom>
val makeTuple : (Relational.Tuple.key * 'a) list -> 'a Relational.Tuple.t
<totom>
(when I try to compile a .ml after having compiled the corresponding .mli)
<totom>
what's the difference between 'a and '_a ?
<kig>
'_a won't compile
<kig>
incomplete type or something
<totom>
well it's the type which was inferred from my .ml file
<totom>
it seems that putting a type indication solves my problem
Yoric[DT] has joined #ocaml
<totom>
when I use "module MyMap = Map.Make (MyType)", the element type is generic
<totom>
but if I know the type of the elements, can I define another module which enforces that type given the MyMap module ?
<kaustuv>
totom: by elements, do you mean the keys?
<totom>
the key type is MyType.t
<totom>
I mean the associated value
<kaustuv>
I think you might have misunderstood the module. The key type is MyType.key. Type 'a MyType.t is the type of maps from key to 'a.
<kaustuv>
Err, ah, I see. MyMap, not MyType.
<kaustuv>
In that case, try: module MyMapConstrained : Map.S where type key = whatever = MyMap
realtime has quit [Remote closed the connection]
realtime has joined #ocaml
<totom>
what's .S ?
Camarade_Tux has joined #ocaml
<totom>
(I want 'a to be defined as int)
ched has quit ["Ex-Chat"]
<totom>
module MyMapConstrained : Map.S where type key = int = MyMap gives a syntax error
ched has joined #ocaml
<mfp>
totom: it's ... with type ...
<totom>
but why do you redefine "key" ? key should still be a MyType.t ??
<totom>
I want the associated value to be an int
<mfp>
so you want to make a module with roughly the same sig as Map.S, but with type t = int MyMap.t ?
<totom>
hrm
<totom>
# module MyMap = Map.Make (String);;
<totom>
module MyMap :
<totom>
sig
<totom>
type key = String.t
<totom>
type 'a t = 'a Map.Make(String).t
<totom>
I want 'a to be "int"
<totom>
so that MyMap.add "a" "b" (MyMap.empty) is not valid
<totom>
but MyMap.add "a" 0 (MyMap.empty) is
<mfp>
module MyMap = struct include Map.Make(String) let empty : string t = empty end;;
<mfp>
oops let empty : int t = empty
<totom>
let's try :-)
schme has quit ["leaving"]
<totom>
hrm, seems to work, but I think it means I have to redefine all the functions like that ?
<mfp>
if you absolutely want to prevent their use with anything but [int MyMap.t], yes
<mfp>
you'd have to take the functions you want from Map.S, and replace 'a t with t, 'a with int
<tsuyoshi>
if you can only create an empty with int, that should be sufficient though
<kaustuv>
err, sorry, with, not where. thanks, mfp
<tsuyoshi>
iirc there's no way to create a map without an empty
<mfp>
module MyMap : sig type key = string type t val is_empty : t -> bool val add : key -> int -> t -> t .... end = Map.Make(String) or such, but as tsuyoshi said, if there's no way to create values of the wrong type there's no pb with the functions not being monomorphic
Axioplase_ has quit [Read error: 104 (Connection reset by peer)]
<flux>
hm, how is that "module List = List include Labels" not mixed up with "module List = List\ninclude Labels"? (regarding mfp's url)
<Yoric[DT]>
flux: mmmmhh.....
<Yoric[DT]>
Probably mixed.
<flux>
well, isn't that a problem then?-)
<Yoric[DT]>
Quite possibly.
<Yoric[DT]>
Could you submit a bug report?
<flux>
I think to qualify I would need to first install alpha 3 and try out what happens :)
<Yoric[DT]>
:)
<flux>
do I need a user account in the forge to do that?
<Yoric[DT]>
yep
<Yoric[DT]>
(gottago, though)
ealar has joined #ocaml
sporkmonger has joined #ocaml
_zack has quit ["Leaving."]
sporkmonger has quit []
<ski__>
kaustuv : hm .. you can match with a `lazy p' pattern, now ?
weechat_user is now known as chicco
<thelema>
ski__: yes, as of 3.11
<ski__>
ok. ty
<totom>
mfp: see the discussion above -- even without using MyMap.empty, I got errors because of incomplete types (hence I want the MyMap.t type to be complete)
mattc58 has left #ocaml []
<totom>
12:16: kig: like Array.create 10;; - : '_a -> '_a array = <fun> -----> I have a function which populates a map, and gets this '_a problem, and hence cannot be defined cleanly in a .mli file
Demitar has quit ["Ex-Chat"]
ealar has quit [Read error: 104 (Connection reset by peer)]
Demitar has joined #ocaml
sporkmonger has joined #ocaml
ealar has joined #ocaml
kelaouchi has joined #ocaml
<kaustuv>
totom: If you use Map.Make, then you should never have '_a t appearing in your code. Generally speaking, such types are a result of running up against the value restiction in the ML type system. Read the first google hit for "value restriction" for a nice introduction if you haven't seen the value restriction before.
Cheshire has quit ["Leaving"]
<Yoric[DT]>
mmmmmmhhhhh....
<Yoric[DT]>
Camlp4 seems often off by 1 line.
<Yoric[DT]>
Gasp, it's actually worse than that, Camlp4 seems to remove some blank lines.
<totom>
kaustuv: try it
<totom>
module Tuple = Map.Make(String);;
<totom>
let makeTuple = List.fold_left (fun t (k,v) -> Tuple.add k v t) Tuple.empty ;;
<totom>
I get val makeTuple : (Tuple.key * '_a) list -> '_a Tuple.t = <fun>
<totom>
exactly like the "Array.make 8" thing
<totom>
so I'd like to hardcode the 'a in my Tuple.t type...
slash_ has joined #ocaml
<kaustuv>
You need to eta-expand your function in these cases.
<kaustuv>
let makeTuple l = List.fold_left (fun t (x, v) -> Tuple.add k v t) Tuple.empty l;;
willb has joined #ocaml
<kaustuv>
err, (k, v) instead of (x, v)
tripwyre has quit []
<totom>
hrm, I think I need to google "eta expansion", I thought let f l = ..... l was strictly equivalent to let f = ....
<kaustuv>
It is, but you can't bind a non value with a polymorphic type in certain situations, such as at the module level. Function applications are not values.
<totom>
hm, ok
<totom>
thanks
love-pingoo has joined #ocaml
dabd has joined #ocaml
<Yoric[DT]>
mfp: your theory seems validate :)
<Yoric[DT]>
mfp: your theory seems validated :)
Yoric[DT] has quit ["Ex-Chat"]
yziquel has joined #ocaml
yziquel has quit [Client Quit]
Yoric[DT] has joined #ocaml
<astronut>
This expression has type bST but is here used with type bST
<astronut>
I'm confused
<Yoric[DT]>
astronut: are you using the toplevel?
<flux>
astronut, you're working in the toplevel and you have old data that depends on an earlier definition of a type
<flux>
astronut, redefine related values, or just restart the toplevel
<astronut>
ah, thanks
<hcarty>
flux, Yoric[DT]: The "module Foo = Foo\ninclude Bar" concern with Batteries seems to be valid, at least when using the toplevel and OCaml 3.11 -- I can submit a bug if you'd like
<flux>
hcarty, well thank you, or perhaps the Batteries community should thank you :)
<Yoric[DT]>
hcarty: please do
<Yoric[DT]>
(and thanks)
<Yoric[DT]>
Mmmmhhh....
<Yoric[DT]>
Yeah, please do.
<hcarty>
Submitted. And I am glad to help.
love-pingoo has quit ["Connection reset by pear"]
_zack has joined #ocaml
<Yoric[DT]>
Of course, this raises the question: what should we do instead?
Stefan_vK has joined #ocaml
mishok13 has quit ["Stopping IRC chat... [OK]"]
s4tan has quit []
ched has quit [Read error: 60 (Operation timed out)]
ched has joined #ocaml
willb has quit [Read error: 60 (Operation timed out)]
ikaros has joined #ocaml
munga has joined #ocaml
ttamttam has left #ocaml []
_zack has quit ["Leaving."]
willb has joined #ocaml
love-pingoo has joined #ocaml
Lockless has joined #ocaml
ttamttam has joined #ocaml
willb has quit [Read error: 60 (Operation timed out)]
willb has joined #ocaml
Lockless has quit ["Ex-Chat"]
Cheshire has joined #ocaml
Waleee has joined #ocaml
<hcarty>
Yoric[DT]: Would "module List = List with Labels" be ok?
<hcarty>
module List = List with Labels, ExceptionLess
dabd has quit ["Ex-Chat"]
<flux>
one thing just came into my mind
<flux>
batteries is now in a great position to allocate a bunch of new keywords, without worrying backwards compatibility too much :)
OChameau has quit ["Leaving"]
<hcarty>
Does Batteries currently have an extension to provide syntax like "include printf, eprintf from Printf" --> "let printf = Printf.printf let eprintf = Printf.eprintf"? I remember some discussion of this in the past but I don't know if it happened or not
<Yoric[DT]>
hcarty: not yet
<Yoric[DT]>
But feel free to add this as a Request for Features, this way we won't be able to forget about it :)
<hcarty>
Yoric[DT]: Will do!
<Yoric[DT]>
thanks
<hcarty>
Does "let function_a = Module.function_a" introduce any extra runtime overhead if one then uses function_a rather than Module.function_a?
<flux>
how about versions for types, modules, etc?
<flux>
or is that reaching too much
<flux>
in any case regular include works for both types and values, but that would work only for values..
<hcarty>
I think modules may not save any typing or clarity. I'm not sure about types though
<flux>
I don't think there's a way to include just some constructors from another module, is there?
<hcarty>
Would that require the full type definition though?
<hcarty>
I don't know if camlp4 can get without a lot of extra work
<hcarty>
It would be cool if it could though
<flux>
it'd be nice if camlp4 was able to access everything the compiler can :)
<flux>
yes. in the higher level, though, programmer -> [ processing ] -> result :)
<hcarty>
Definitely :-) As long as the processing terminates
<Cheshire>
hehe
<flux>
well, nothing guarantees itself terminates. although that kind of mechanism could perhaps be considered to be a can of worms..
<flux>
itself = camlp4
<Cheshire>
input -> proccess -> output this is like being in school again :p
<flux>
but it would definitely be powerful if compiler information could be fed back to a developer-written module
ttamttam has left #ocaml []
<hcarty>
Yes, it would be interesting to witness what people come up with given, for example, type information
<flux>
perhaps there could be camlp4 -> type inference -> some other camlp4-like mechanism -> compiling
<flux>
atleast if type inference would give back a tree you could modify
<flux>
but if you could also make calls back to type inference, or redo it altogether.. that would be more complicated, but otoh, might simplify certain matters
<flux>
at the moment if you wish to do some type-aware processing with camlp4 the only option is to do type inference your self. in essence, reproduce a large amount of the compiler yourself.
<flux>
and that's far from ideal :)
<flux>
(and AFAIK nobody's tried doing it)
<hcarty>
pa-do uses Int.(), Float.(), etc to do things along those lines. But this is, as you said, effectively doing the inference your self
<hcarty>
Though I'm quite happy with the results of pa-do. I have found it wonderfully useful.
<flux>
hmm.. isn't it quite a strech to call it doing type inference, or have I misunderstood how it works?
<flux>
(I don't actually know, I've just made guesses from examples :))
<Yoric[DT]>
hcarty: "with" doesn't work, we already use keyword "with" for initialisation of modules.
<hcarty>
flux: Well, "your self" is the programmer here
<hcarty>
So it's not really type inference as much as "I expect this to be the default type here"
<Yoric[DT]>
No matter how much energy we put in it, "include foo from Bar" couldn't determine whether "foo" is a type or a value -- it could actually be both.
<hcarty>
Yoric[DT]: Could it be used for both? IIRC, camlp4 can distinguish between modules and values
<Yoric[DT]>
hcarty: mmmmhhhhh....
<Yoric[DT]>
Are you sure?
<Yoric[DT]>
How can it distinguish between a module name and a constructor?
<hcarty>
Yoric[DT]: True
<hcarty>
Oh, right... UIDENT and IDENT or something along those lines
<hcarty>
Well, I'm thinking specifically of values in the case of "include foo from Bar"
<hcarty>
I'm not sure how useful "include foo_t from Bar" would be for a type foo_t unless camlp4 could find and pick out the definition of foo_t from Bar
<hcarty>
From the definition of Bar, that is
<Yoric[DT]>
I concur that this would be useful mostly for values anyway.
<hcarty>
Regarding the use of with - do "open X with init ()" and "module X = Y with A, B" interfere with one another?
* Yoric[DT]
checks.
<Yoric[DT]>
It shouldn't.
<Yoric[DT]>
Well, I guess that trying it can't hurt.
<Yoric[DT]>
hcarty: about your RfF on --.
<Yoric[DT]>
Would you put this in Pervasives or in Float?
<hcarty>
Yoric[DT]: Pervasives would be my preference. But I don't know how often others would use it.
<Yoric[DT]>
I'm wondering if this should actually be generalized.
<hcarty>
Where are the other enum operators placed?
<Yoric[DT]>
Well, -- and --- are in Pervasives. But there's also a version in Int, Int32, Int64, etc.
<Yoric[DT]>
The operator you describe could have a meaning both for floats, integers, etc.
<hcarty>
Yoric[DT]: True
astronut has quit [Read error: 113 (No route to host)]
thelema_ has joined #ocaml
<hcarty>
I'm not sure what the default in Pervasives should be, then
<hcarty>
I would personally prefer float in Pervasives (op-plus-. generally refers to floating point operators) but versions for other types could be added to the other numeric modules
willb has quit [Connection timed out]
<Yoric[DT]>
Actually, it could be --* in each module and --. in Pervasives, specifically for float.
<thelema_>
for a range of floating point numbers? Don't you need a 3rd parameter, the step?
<hcarty>
thelema_: It's (start, step) --. end
<hcarty>
At least that's what I have in the feature request
<thelema_>
hc: really? float -> float -> ~step:float -> float enum would have syntax... [1.0 --. 10.0 ~step:0.5]
<hcarty>
thelema_: I think that is harder to read, and still needs () or an extra ~ for negative values
<hcarty>
I may be outvoted on this
<thelema_>
I like the fact that step is self-documenting. Where would you need the extra ~?
<hcarty>
Would ~step:-1.0 work?
<hcarty>
I'm not sure
<Yoric[DT]>
I don't think so.
<thelema_>
you're right, the lack of delimiters (parens, comma) around start/step does pose parsing problems
<thelema_>
you're right, it'd parse as (~step:-) 1.0
<thelema_>
but that's just the general problem of - parsing funny
<thelema_>
(fixable by camlp4?)
<hcarty>
I need to leave for a seminar. I'm happy to catch up on comments here and discuss this later though.
* thelema_
isn't really here, he's at work.
<Yoric[DT]>
cheers
<thelema_>
It's a good suggestion. If you implement your version, we'll probably include it as you implement it.
<thelema_>
I might be running into the doghouse problem myself (wanting to put my fingerprints all over your good idea because the idea is simple enough to think myself an expert at)
<Yoric[DT]>
:)
<thelema_>
It's natural to try to improve something you know about, but if it's not that important how it's done, ... you just keep the something from getting done
willb has joined #ocaml
mrpingoo has joined #ocaml
love-pingoo has quit [Read error: 104 (Connection reset by peer)]
mrpingoo is now known as love-pingoo
pango has joined #ocaml
patronus has quit ["leaving"]
patronus has joined #ocaml
det has quit [Read error: 104 (Connection reset by peer)]
det has joined #ocaml
det_ has joined #ocaml
det has quit [Read error: 104 (Connection reset by peer)]
schme has joined #ocaml
ttamttam has joined #ocaml
ttamttam has left #ocaml []
seafood has joined #ocaml
realtime has left #ocaml []
<Yoric[DT]>
thelema_: I need help with fetching.
Cheshire has quit [Read error: 113 (No route to host)]
<Yoric[DT]>
Git informs me that « maybe you are not up-to-date and need to pull first? »
<thelema_>
you mean git fetch + git rebase instead of git pull?
<Yoric[DT]>
Exactly what do I do now?
<thelema_>
what I do is: git fetch ocamlcore
<Yoric[DT]>
([git fetch] alone didn't seem to do anything)
hkBst has quit [Read error: 104 (Connection reset by peer)]
Cheshire has joined #ocaml
<thelema_>
you can set up git fetch to auto-fetch from a certain repo, but I've not got that setup on my box, so I can't help there.
<thelema_>
yes, that's the rebasing you're seeing - your modifications to whatever code you had originally checked out are being rewritten to apply to the current head on ocamlcore.
* thelema_
reads the pastebin
<thelema_>
fix your Changelog (same as a merge conflict) and do [git rebase --continue]
<Yoric[DT]>
yoric@Blefuscu:~/batteries$ git rebase --continue
<Yoric[DT]>
You must edit all merge conflicts and then
<Yoric[DT]>
mark them as resolved using git update-index
<Yoric[DT]>
Should I [git update-index]?
<thelema_>
no, I wish they'd fix that...
* Yoric[DT]
asks at every step, as the help on [git pull --rebase] mentioned that it was a dangerous feature.
<thelema_>
[git add ChangeLog]
<Yoric[DT]>
Yeah.
<Yoric[DT]>
Seems to work.
<thelema_>
it's something that can cause desynchronization between your repo and the global repo
<brendan>
you might have been happier with hg. much simpler ui :)
<thelema_>
if you push something global and then rebase it, it disappears from your repo.
<hcarty>
brendan: I tried hg, and it seemed quite similar to git, but without the in-place branches
<thelema_>
brendan: of course your project is better. The image viewer I wrote for myself is the best in the world.
<brendan>
It's only because I've seen these git walkthroughs a few times here now that I said that
<thelema_>
brendan: git could use a better [git whats-going-on] function. The first time I rebased, I lost the --continue command (scrolled off screen), and I ended up killing the whole rebase. That said, I dunno if rebasing can be made simpler.
<thelema_>
Yoric[DT]: when you're done rebasing, [git push] will work as normal
<Yoric[DT]>
Yes, done.
<Yoric[DT]>
(and pushed)
<Yoric[DT]>
Now testing Jérémie's patch :)
<thelema_>
great. sorry for the trouble. don't forget to grab your code out of the stash branch
* Yoric[DT]
will try and remember to do that.
<Yoric[DT]>
Thanks.
<thelema_>
should go much faster next time if everything is checked in. The only problem was the unchecked in code.
<thelema_>
aside from that, [git fetch] (which prints nothing if it does nothing) [git rebase remotes/origin/master] (needs clean tree) [git push] is the best pattern.
<thelema_>
and one day I'll invent a 3-way merge that works correctly for ChangeLog files.
ikaros has quit [".quit"]
<brendan>
why even version the changelog?
willb has quit [Read error: 110 (Connection timed out)]
<thelema_>
brendan: we'll eventually have a proper changelog that's different from the detailed changelog produced by VCS checkins
sporkmonger has joined #ocaml
sporkmonger has quit [Client Quit]
sporkmonger has joined #ocaml
sporkmonger has quit [Client Quit]
after_fallout has left #ocaml []
vovkaii has quit [Read error: 110 (Connection timed out)]
thelema_ has quit ["ChatZilla 0.9.84 [Firefox 3.0.6/2009011913]"]