<palomer>
the pastebin more clearly says what I wantto do
<olegfink>
Shadow777: if you want to write in such a way, you'll have to suspend e1 and e2 so that they're not both get evaluated regardless of c.
sgnb` has joined #ocaml
<palomer>
in that example, x really has type [`B]
<palomer>
not type [`A]
sgnb has quit [Read error: 104 (Connection reset by peer)]
<Shadow777>
olegfink: like add a function that evaluate e1 and e2 with delay ?
<olegfink>
probably the easiest way to suspend a value 'e' is to substitue it for 'fun () -> e'
<kaustuv>
palomer: what in that error is confusing? For the arm x -> x, the pattern x has type t, and the conclusion has type [> `C] (because the first arm returns `C). Clearly t is not compatible with [> `C] because it doesn't contain `C.
<kaustuv>
Shadow777: why not use if ... then ... else in the body of fact instead of if2?
<Shadow777>
kaustuv: i know it works that way, i am just exploring :)
<olegfink>
heh, HM predefined constraints :/
<palomer>
kaustuv, but you could also say that x has type [`B]
<olegfink>
# let true = fst ;;
<olegfink>
Error: This expression has type 'a * 'b -> 'a but is here used with type bool
<kaustuv>
palomer: In the arm x -> x, x has type t because you constrain the expression being matched to type t.
<palomer>
yes
<palomer>
but the first pattern removes the possibility that x is `A
<kaustuv>
It doesn't matter. The error is not there but on the right hand side.
<olegfink>
i can't redefine true, what a shame.
<kaustuv>
The first arm makes the entire match have type [> `C]. The second makes it have type t. They are not compatible. To see it, skip polymorphic variants and try:
<kaustuv>
type t = A | B ;;
<kaustuv>
let x = match A with A -> `C | x -> x ;;
<olegfink>
Shadow777: if you're experimenting, I suggest you finding a way to write if2 without if.
<palomer>
but that function never returns `A
<palomer>
err
<palomer>
that value couldn't possibly be [`A]
<kaustuv>
I think your misconception is that the patterns in a match can have different types. This is not the case.
<Shadow777>
olegfink: i noticed the same thing happen using matching pattern
<maxote>
kaustuv, for polymorphic type system, DHM is not very good, e.g. f(x) is for DHM, Deriv(X) where X can be passed by f(x) is a little complicate, and i think System-F can do it, but i don't know much of it.
_jedai_ has quit [Connection timed out]
|jedai| has joined #ocaml
jeddhaberstro has quit []
pixel_ has quit [brown.freenode.net irc.freenode.net]
astronut has quit [brown.freenode.net irc.freenode.net]
mal`` has quit [brown.freenode.net irc.freenode.net]
jburd has quit [brown.freenode.net irc.freenode.net]
rhar has quit [brown.freenode.net irc.freenode.net]
mytoz has quit [brown.freenode.net irc.freenode.net]
maxote has quit [brown.freenode.net irc.freenode.net]
petchema has quit [brown.freenode.net irc.freenode.net]
caligula_ has quit [brown.freenode.net irc.freenode.net]
sitaktif has quit [brown.freenode.net irc.freenode.net]
TaXules has quit [brown.freenode.net irc.freenode.net]
sitaktif has joined #ocaml
rhar has joined #ocaml
mytoz has joined #ocaml
maxote has joined #ocaml
petchema has joined #ocaml
caligula_ has joined #ocaml
TaXules has joined #ocaml
pango has joined #ocaml
pango has quit [Nick collision from Idoru.]
astronut has joined #ocaml
pixel_ has joined #ocaml
jburd has joined #ocaml
mal`` has joined #ocaml
Melanoma1ky has quit ["leaving"]
MelanomaSky has joined #ocaml
pseudosaint has left #ocaml []
Shadow777 has quit [Remote closed the connection]
thelema has joined #ocaml
angerman has quit []
MelanomaSky has quit [brown.freenode.net irc.freenode.net]
MelanomaSky has joined #ocaml
Associat0r has quit []
alexyk has quit []
angerman has joined #ocaml
jld has quit [Read error: 104 (Connection reset by peer)]
Fullma has quit [Read error: 110 (Connection timed out)]
Fullma has joined #ocaml
Alpounet has joined #ocaml
Camarade_Tux has joined #ocaml
erg has quit ["leaving"]
astronut has quit [Read error: 60 (Operation timed out)]
jld has joined #ocaml
sgnb` is now known as sgnb
astronut has joined #ocaml
animist has quit ["Leaving"]
alexyk has joined #ocaml
alexyk has quit []
_zack has joined #ocaml
astro has joined #ocaml
astronut has quit [Read error: 113 (No route to host)]
smimou has quit [Read error: 110 (Connection timed out)]
Alpounet has quit [Read error: 104 (Connection reset by peer)]
Alpounet has joined #ocaml
smimou has joined #ocaml
Snark has joined #ocaml
tripwyre has joined #ocaml
s4tan has joined #ocaml
palomer has quit [Remote closed the connection]
<rwmjones>
_zack, ocamlnet 2.2.9, against ocaml 3.11.0 & camlp4
<_zack>
rwmjones: yup, sorry for parting yesterday, but in the end I dug in your cvs and stole the workaround patch for calmp310 regression
<_zack>
thus far I've been building ocamlnet with camlp5, but a tiny (yet horrible :)) patch is better
<rwmjones>
yup ... isn't there a more recent version of ocamlnet?
<_zack>
rwmjones: unfortunately not
<_zack>
indeed I'm curious how they build it in GODI, but I haven't checked
<_zack>
btw, the comment in your patch is a bit misleading
<_zack>
it is not that `IN in camlp4 is forbidden at all as a keyword, is forbidden only if you use camlp4 with the macro machinery a-la cpp
fibonacci2 has left #ocaml []
<_zack>
rwmjones: ^^
<rwmjones>
uh huh ... I sent the patch upstream anyhow
<_zack>
I've reported the bug in the caml BTS (AFAICT it hasn't been yet), we'll see
arquebus has joined #ocaml
arquebus has left #ocaml []
mrvn has quit ["reboot"]
angerman has quit []
Ched has joined #ocaml
tripwyre has quit []
mrvn has joined #ocaml
Ched has quit [Remote closed the connection]
Ched has joined #ocaml
Fullma has quit [Read error: 113 (No route to host)]
Demitar has quit [Remote closed the connection]
hkBst has joined #ocaml
Demitar has joined #ocaml
theIdeaMen has joined #ocaml
meatbag has joined #ocaml
spyker has joined #ocaml
verte has quit [Read error: 60 (Operation timed out)]
verte has joined #ocaml
ChristopheT has joined #ocaml
hkBst has quit [Remote closed the connection]
hkBst has joined #ocaml
spyker has quit ["Ex-Chat"]
joelr1 has joined #ocaml
<joelr1>
good day
<joelr1>
can ocamlbuild be used to build c libraries together with ocaml code? i'm almost sure it can be but i forgot the instructions :(
<theIdeaMen>
I'm having trouble unstanding Stream syntax (with camlp5 - original). I get the idea of lazy lists, but I'm just not sure what is going on here. The example at the bottom of this page got me.
<theIdeaMen>
let rec sum s = match s with parser [< 'n; r = sum >] -> n+r | [<>] -> 0;;
<theIdeaMen>
the "r = sum" part is what confuses me
<theIdeaMen>
why don't you have to give an argument for sum?
Camarade_Tux has quit [Remote closed the connection]
Camarade_Tux has joined #ocaml
alexyk_ has joined #ocaml
alexyk_ has quit [Client Quit]
alexyk has quit [Read error: 110 (Connection timed out)]
brendan has joined #ocaml
ronwalf has joined #ocaml
philip_ has joined #ocaml
Ched has quit [Remote closed the connection]
<flux>
has someone used pgocaml with ocamlfind successfully?
<flux>
actually my goal is to make it work with ocamlbuild too, but I'm going with smaller steps..
<flux>
my current attempt is: ocamlfind ocamlc -o test_pgocaml -package pgocaml,pgocaml.statements -syntax pgocaml.statements test_pgocaml.ml
<flux>
but that just gives: No level labelled "top" in entry "expr"Failure: "Grammar.extend"File "test_pgocaml.ml", line 1, characters 0-1:Error: Preprocessor error
s4tan has quit []
<flux>
argh, of course: -syntax camlp4o, forgot about that
philip_ has quit [Read error: 110 (Connection timed out)]
theIdeaMen has quit []
meatbag has quit ["JESUS CHRIST, IT'S A LION! GET IN THE CAR!"]
prime2 has joined #ocaml
|jedai| has quit [Read error: 110 (Connection timed out)]
alexyk has joined #ocaml
|jedai| has joined #ocaml
kaustuv_ has joined #ocaml
prime2 has quit [Remote closed the connection]
<rwmjones>
flux, I've got a new release of pg'ocaml coming which should fix that. At the moment the META file is a bit broken.
<rwmjones>
it was supposed to happen two weeks ago, along with a virt-df release, then last week, then this week, now ....
prime2 has joined #ocaml
sgnb has quit [Read error: 104 (Connection reset by peer)]
sgnb has joined #ocaml
_zack has quit [Read error: 104 (Connection reset by peer)]
_zack has joined #ocaml
Cheshire has quit [Read error: 113 (No route to host)]
Cheshire has joined #ocaml
Ched has joined #ocaml
<flux>
well, that was a honest user error
ronwalf has quit []
<flux>
this is my first time using it for something, seems to be working nicely
Alpounet has quit ["Ex-Chat"]
_zack has quit ["Leaving."]
Alpounet has joined #ocaml
Ched has quit [Remote closed the connection]
Ched has joined #ocaml
sgnb has quit [Read error: 104 (Connection reset by peer)]
sgnb` has joined #ocaml
bluestorm has joined #ocaml
arquebus has joined #ocaml
<munga>
hello.
<munga>
I'm wondering if ocamlgraph is thread safe if I only do inserts
<munga>
(not remove, no marking, no visits), just add_vertex , add_edge
<munga>
I would say generally no, but I'm wondering if it might be ok in this specific case
<flux>
is it functional?
<flux>
if not, I would say no?
<flux>
(of course it doesn't help if it's functional, you need to thread around the constructed versions)
<flux>
didn't ocamlgraph have both apis..
ronwalf has joined #ocaml
ronwalf has quit [Client Quit]
Amorphous has quit [Read error: 110 (Connection timed out)]
Amorphous has joined #ocaml
<tarbo2>
hello, i have two related questions, both of which i have looked for answers to, but which may show my novice level. i will be happy with a doco pointer.
<tarbo2>
i am playing with batteries for the first time, and wanted to use some of the library in the repl (toplevel?)
<tarbo2>
but i have a netbook (specifically, a debxo) and loading batteries with ocamlfind batteries/ocaml takes a good fifteen seconds
<tarbo2>
so the questions are: is there a way to bring in a particular module from the library without loading all of batteries?
<tarbo2>
and, is there a way to save an image so the loading doesnt have to be redone every time i want to try some code?
<flux>
I think it is not possible to load one module from batteries, although that's being worked on
<flux>
it is possible to build a new toplevel with batteries
Fulax has joined #ocaml
<flux>
doesn't batteries come with its own toplevel?
<flux>
it it doesn't, well, I don't know how to make it, though :). possibly something like ocamlfind ocamlmktop -package batteries -custom -o batteriestoplevel
<flux>
one problem is that even if you make your own toplevel, you need to tell it where to find the .cmi-files..
<flux>
and that is most conveniently done with #require "batteries", but it doesn't work properly in this case
<flux>
you'd need to find the list of directories batteries has .cmi-files in and add them to a .ocamlrc-file
<tarbo2>
yes, i think this will do for #2. thanks flux, ski__
<Yoric[DT]>
flux: well, building toplevel didn't work with OCaml 3.10, so we haven't pursued that particular point.
ehird has joined #ocaml
<ehird>
is there a way to get at the native continuation, that is, callcc : (('a -> 'b) -> 'a) -> 'a ?
<Camarade_Tux>
is there anything that can quickly map a C struct to ocaml values ?
<Alpounet>
anyway, OCaml 3.11 will be the default version soon in package servers, GODI, ...
<Alpounet>
I guess.
<flux>
camarade_tux, if by quickly you mean with high performance then I don't think so. there is ocamlidl though, if you just want to avoid the legwork.
<Yoric[DT]>
ehird: no
<ehird>
:(
<Yoric[DT]>
(there's a patch for that purpose, but I don't think it's maintained)
<ehird>
i'm toying with a hack to do variadic functions; I've almost got it working apart from some return issues :-)
<Camarade_Tux>
flux, no, by quickly I just wanted something which wouldn't require much code or deps
<ehird>
was why I asked
<Yoric[DT]>
ehird: well, the closest you're going to get (if you want regular native code) is exceptions.
<Camarade_Tux>
but I should be able to use the regular ocaml functions
<ehird>
Yoric[DT]: yep, I'm using exceptions
<ehird>
but it's hard to wrap them to give an actual value back
<Yoric[DT]>
ehird: have you tried exceptions + references?
<ehird>
— but returns via an exception, instead of a regular result, which I think is probably impossible
<Yoric[DT]>
Well, you can return via exceptions.
<Yoric[DT]>
(see url above)
<ehird>
yes, that requires you to do (label (counter false false false true)), though, doesn't it?
<ehird>
as opposed to just (counter false false false true)?
<Yoric[DT]>
This return should stop the whole recursive loop, shouldn't it?
theIdeaMen has joined #ocaml
<ehird>
I believe it does, in my version (which needs -rectypes)
<ehird>
because it raises an exception
<ehird>
I think the issue is that it has to both return (bool -> 'a as 'a) _and_ (int)
<ehird>
to be able to do it without wrapping
<Yoric[DT]>
Where's stop?
<Yoric[DT]>
Ah, ok, my bad.
<Yoric[DT]>
No, I'm right, you never initialise stop, do you?
<ehird>
let rec inner return count stop =
<Yoric[DT]>
I mean, what type do you wish to return?
<ehird>
int, when stop is true
<ehird>
but when it's not true, keep listening for arguments. I'm pretty sure that means you have to be able to have one function return two types, hwich is impossible
<Yoric[DT]>
Let me rephrase: [counter] whould have type [int -> int], is that it?
<ehird>
# counter;;
<ehird>
- : bool -> 'a as 'a = <fun>
<ehird>
That's just the thing - counter takes an arbitrary amount of arguments
<ehird>
which works with the exception scheme
<Yoric[DT]>
Ah, ok.
<ehird>
I'm 99% certain it can't be done any other way now
<Yoric[DT]>
Ok.
* Yoric[DT]
starts to understand.
<Yoric[DT]>
Well, that's a bit too complex given the number of things I'm already doing at once :)
<Yoric[DT]>
Gosh, hebrew is really a weird language :)
<ski__>
oh, sorry, i looked up the wrong acronym .. s/Rabbinist/Unestablishable/
<ski__>
(habit made be enter "iirc" when i meant to enter "iiuc")
<ski__>
val printf : ('a, formatter, unit) format -> 'a
<ski__>
val sprintf : ('a, unit, string) format -> 'a
<Camarade_Tux>
Yoric[DT], "understand" ;)
<Yoric[DT]>
:)
<Yoric[DT]>
Camarade_Tux: have I answered your e-mail, btw?
<ski__>
suggests to me that the third type argument to `format' is the type of the "final return value", and the first is the type of the returned (usually) function, that will eat inputs
<Camarade_Tux>
Yoric[DT], no
<ski__>
so, one can imagine
<Camarade_Tux>
you probably don't need to actually
<Yoric[DT]>
Camarade_Tux: good, because I have difficulties keeping track of everything I need to do :)
<Camarade_Tux>
Yoric[DT], hehe
<ski__>
e.g.
<ski__>
sprintf (lit "s = " ^^ str ^^ " and x = " ^^ int) "hello" 42
<ski__>
would return
<ski__>
"s = hello and x = 42"
<ski__>
(of course i forgot two `lit's in there, before the two latter string literals in the format ..)
<Camarade_Tux>
Yoric[DT], actually, I need to know if it's possible to ship some C code with the bindings (I don't know how spread is 7z.so [plus it's a big c++ lib which will take a long time to completely bind])
<Camarade_Tux>
(about 300KB but maybe less)
<Yoric[DT]>
For 1.0, I'd like to avoid that.
<Yoric[DT]>
This sounds like a major build system breaker.
<Camarade_Tux>
ok, no problem :)
wusr has quit [Read error: 104 (Connection reset by peer)]
Fullma has joined #ocaml
arquebus has left #ocaml []
jonasb has joined #ocaml
<bdc334>
I'm having a problem compiling a module when using another module I wrote. Where can I find some documentation and examples of using and compiling modules?
jonasb has quit [Read error: 104 (Connection reset by peer)]
ehird has left #ocaml []
ehird has joined #ocaml
ehird has left #ocaml []
ehird has joined #ocaml
sporkmonger has quit []
sporkmonger has joined #ocaml
alexyk has quit []
bdc334 has quit ["using sirc version 2.211+KSIRC/1.3.12"]
alexyk has joined #ocaml
<ehird>
I'm not sure you actually can use formats
<ehird>
they don't seem to do arbitrary stuff
alexyk has quit [Client Quit]
<bluestorm>
that "False False False Jason Hickey Book" story sure looks messy
<Yoric[DT]>
Yeah
|jedai| has quit [Read error: 60 (Operation timed out)]
|jedai| has joined #ocaml
Camarade_Tux has quit ["Leaving"]
<brendan>
what story is that? I read and enjoyed a pdf that had jason hickey's name on it
<bluestorm>
brendan: that's on the mailing list about now
<bluestorm>
There is a new ocaml book wich has just been published
<bluestorm>
and there are suspicions that it may actually be a plagiarism of jason hickey book
<brendan>
the Tim Rentsch one?
<bluestorm>
yes
<brendan>
oh wow
<bluestorm>
nothing is sure yet, but that's still a little disappointing
<Alpounet>
indeed...
<bluestorm>
(i was happy to have an OCaml book that I could recommend to other peoples, and is not out of print; I'll have to wait a bit more)
<schme>
I ordered that rentsch book just some days ago.
<Alpounet>
and ?
<Alpounet>
not arrived yet ?
<schme>
Nope.
<schme>
Supposedly they should have shipped it today, but my order is still "being processed"
hkBst has quit [Read error: 104 (Connection reset by peer)]
Mr_Awesome has quit [Read error: 110 (Connection timed out)]
<schme>
Hmmm.. Looking at this Rentsch book it sure seems to have been published by some strange publisher. with a site just saying "under konsruction"
<schme>
I think I'll unorder this. Thanks guys, you saved me some money :)
<bluestorm>
there is also "Le langage Caml" wich is a great book imho, but it's Caml Light and in French
sgnb` is now known as sgnb
prime2 has quit [Read error: 110 (Connection timed out)]
bluestorm has quit [Remote closed the connection]
<Alpounet>
there is also "Programmation fonctionnelle, générique et objet" but also in French
<Yoric[DT]>
'night everyone
Yoric[DT] has quit ["Ex-Chat"]
Cheshire has quit ["Leaving"]
mint234234 has joined #ocaml
mint234234 has quit [Client Quit]
det has quit [Remote closed the connection]
rwmjones_ has joined #ocaml
sporkmonger has joined #ocaml
<kaustuv_>
I had immediate misgivings about Tim Rentsch and his book and am sad to see my gut reaction confirmed.
* rwmjones_
enters the world of the strange
* rwmjones_
thinks there is a curse associated with ocaml books