MaskRay has quit [Read error: Connection reset by peer]
MaskRay_ has joined #ocaml
tmaeda is now known as tmaedaZ
bobzhang has joined #ocaml
<bobzhang>
does any one know how to read this type " [< `a | `b > `a ] = `a"
<bobzhang>
thanks
<everyonemines>
is that f# ?
<_habnabit>
looks like ocaml
<mrvn>
up until the >
<mrvn>
bobzhang: Looks like a subset of `a or `b with a constraint that `b is a supertype of `a all aliased as `a from then on.
ulfdoz_ has joined #ocaml
<bobzhang>
mrvn: let f x = (x : [> `a] :> [< `a | `b]);;
<bobzhang>
I did some experiment on coercion, and get a werid type
<mrvn>
val f : ([< `a | `b > `a ] as 'a) -> 'a = <fun>
<mrvn>
Now that looks like ocaml :)
<bobzhang>
mrvn: sure, it's ocaml
<bobzhang>
what's its meaning?
<mrvn>
bobzhang: you typed something else above.
<bobzhang>
mrvn: oh, sorry '= `a' is a value, should be removed
ulfdoz has quit [Ping timeout: 248 seconds]
ulfdoz_ is now known as ulfdoz
<mrvn>
bobzhang: as said a subset of `a or `b with the constraint that `b is a supertype of `a (as in can be coerced to `a) and input and output type are the same.
<bobzhang>
`b > `a means `b is a supertype of `a?
<bobzhang>
yes, it makes sense
<bobzhang>
is it documented anywhere?
<mrvn>
bobzhang: It means some type between [ `a ] and [ `a | `b ]
<bobzhang>
mrvn: sorry, I don't get it, can you elaborate a bit?
everyonemines has quit [Quit: Leaving.]
<mrvn>
bobzhang: It must be a type that contains at least `a but can also contain `b
<bobzhang>
mrvn: so except `a is a value of this type, any other value?
<mrvn>
# let f x = (x : [> `a] :> [< `a | `b]);;
<mrvn>
# let x = (`b : [ `b ]);;
<mrvn>
# f x;;
<mrvn>
Error: This expression has type [ `b ] but an expression was expected of type
<mrvn>
[< `a | `b > `a ]
<mrvn>
The first variant type does not allow tag(s) `a
<mrvn>
See, x does not allow `a so it fails. But f `b works.
<mrvn>
I'm not sure where or why you would need this though.
<bobzhang>
mrvn: just for curiosity
<bobzhang>
x for `a works
<bobzhang>
x for `b does not work
<mrvn>
bobzhang: because [`b] is not a superset of [`a]
<mrvn>
let x = (`b : [> `b ]);;
<bobzhang>
mrvn: actually both works (f `a, f `b)
<mrvn>
that works because [> `b ] and [> `a] can be unified (?).
<mrvn>
bobzhang: A literal `b is of type [> `b]
<bobzhang>
mrvn: I get it now
<bobzhang>
mrvn: so `b will be comprehended as [> `b] as default?
<mrvn>
# `b;;
<mrvn>
- : [> `b ] = `b
<bobzhang>
# `b;;
<bobzhang>
mrvn: thanks!
<bobzhang>
I thought there was an lambdabot like haskell channel...
cyphase has quit [Ping timeout: 260 seconds]
roha has quit [Ping timeout: 255 seconds]
cyphase has joined #ocaml
mjonsson has joined #ocaml
Fnar has quit [Ping timeout: 260 seconds]
iago has quit [Quit: Leaving]
Fnar has joined #ocaml
tonyg has left #ocaml []
Fnar has quit [Changing host]
Fnar has joined #ocaml
mjonsson_ has joined #ocaml
mjonsson_ has quit [Client Quit]
oriba has quit [Quit: oriba]
jave has quit [Ping timeout: 260 seconds]
struktured has quit [Ping timeout: 245 seconds]
jave has joined #ocaml
struktured has joined #ocaml
Fnar has quit [Ping timeout: 260 seconds]
Fnar has joined #ocaml
chambart has quit [Ping timeout: 252 seconds]
TaXules_ has quit [Ping timeout: 240 seconds]
chambart has joined #ocaml
haelix_ has quit [Ping timeout: 252 seconds]
haelix has joined #ocaml
rixed has quit [Ping timeout: 252 seconds]
fraggle_ has quit [Ping timeout: 272 seconds]
rixed has joined #ocaml
svenl has quit [Ping timeout: 276 seconds]
svenl has joined #ocaml
fraggle_ has joined #ocaml
struktured has quit [Remote host closed the connection]
TaXules has joined #ocaml
struktured has joined #ocaml
bobzhang has quit [Read error: Operation timed out]
pango has quit [Ping timeout: 252 seconds]
pango has joined #ocaml
testcocoon has quit [Read error: Operation timed out]
zorun has quit [Read error: Operation timed out]
zorun has joined #ocaml
gnuvince_ has quit [Ping timeout: 245 seconds]
testcocoon has joined #ocaml
mjonsson has quit [Remote host closed the connection]
gnuvince has joined #ocaml
mattrepl has quit [Quit: mattrepl]
Cyanure has joined #ocaml
Fnar has quit [Changing host]
Fnar has joined #ocaml
larhat has quit [Quit: Leaving.]
larhat has joined #ocaml
Cyanure has quit [Ping timeout: 244 seconds]
mononofu has joined #ocaml
Xizor has joined #ocaml
ulfdoz has quit [Quit: brb]
mononofu has quit [Remote host closed the connection]
mononofu has joined #ocaml
lorill has joined #ocaml
ulfdoz has joined #ocaml
err404 has joined #ocaml
GPHemsley has quit [Ping timeout: 252 seconds]
Hussaind has joined #ocaml
GPHemsley has joined #ocaml
GPHemsley has quit [Changing host]
GPHemsley has joined #ocaml
lorill has quit [Quit: Quitte]
hiptobecubic has joined #ocaml
Snark has joined #ocaml
ggherdov has joined #ocaml
Submarine has joined #ocaml
Submarine has quit [Changing host]
Submarine has joined #ocaml
jimny has joined #ocaml
roha has joined #ocaml
Kakadu has joined #ocaml
eni has joined #ocaml
Xizor has quit []
roha has quit [Ping timeout: 252 seconds]
Kakadu has quit [Quit: Page closed]
MaskRay_ has quit [Quit: leaving]
fraggle_ has quit [Read error: Connection reset by peer]
fraggle_ has joined #ocaml
fraggle_ has quit [Read error: Connection reset by peer]
fraggle_ has joined #ocaml
Tobu has quit [Ping timeout: 272 seconds]
Tobu has joined #ocaml
<mrvn>
win shrink 20
<mrvn>
ups
<mrvn>
Can I create a value that is all bits 0 from ocaml or do I need C function for that?
<Qrntz>
mrvn, «Obj.new_block [tag] [size]» ?
<mrvn>
Qrntz: Is that 0 filled instead of with ()?
<Qrntz>
well, it is initialized with «for (i = 0; i < sz; i++) { Field(res, i) = Val_long(0) }»
<Qrntz>
I think so
<mrvn>
Qrntz: That results in 1 since long is taged.
<mrvn>
Wasn't there a way to declare a value of type 'a t in a module? Values do not match: val nil : '_a t is not included in val nil : 'a t
s_p has joined #ocaml
<s_p>
There is camlp5 parser and preatyprinter that allows me to use <<forall x. p(x)>> for FOL formulas inside the interpreter.
<s_p>
However when I try to use the <<>> shorthand syntax inside my *.ml files I get an error.
<s_p>
Before using the shorthand syntax I #use the needed libraries, but that seams not to help.
<mrvn>
s_p: #... commands are toplevel only.
<mrvn>
open Module
<mrvn>
and the camlp stuff you need to specify on the command line somehow
<s_p>
mrvn: I see, thank you.
lihaitao has joined #ocaml
larhat has quit [Quit: Leaving.]
mattrepl has joined #ocaml
letrec has joined #ocaml
ttamttam has joined #ocaml
struktured has quit [Read error: Operation timed out]
smerz has joined #ocaml
ggherdov has quit [Quit: bye folks]
MaskRay has joined #ocaml
MaskRay has quit [Changing host]
MaskRay has joined #ocaml
BiDOrD_ has quit [Read error: Operation timed out]
BiDOrD has joined #ocaml
ttamttam has quit [Ping timeout: 252 seconds]
ski has quit [Read error: Operation timed out]
ski has joined #ocaml
<mrvn>
Shouldn't there be a way to tell ocaml wether a type is mutable or immutable in itself?
emmanuel__ has joined #ocaml
<pippijn>
mrvn: you mean like type mint = mutable int?
<mrvn>
pippijn: more like type t = mutable <abstract>
<mrvn>
type string should be flaged mutable while type 'a list is immutable.
<flux>
well, ocaml doesn't have mutable values per se. but you can achieve similar expressiveness with phantom typing?
<flux>
for example battries comes with a capabilities string library
<mrvn>
Would be nice if the compiler could infer wether a function could be memorized or common subexpressions could be eliminated.
<flux>
I don't think we're ever going to see that in ocaml :)
<flux>
besides how often would such optimizations really be beneficial?
<mrvn>
flux: always.
<flux>
it isn't obvious that memoization is always beneficial
<flux>
for example, it consumes memory
lihaitao has quit [Quit: Ex-Chat]
<mrvn>
no, but common subexpression elimination is
<flux>
the function can be simple
<flux>
etc
<flux>
but how often do you have expressions wtih common subexpressions?
<mrvn>
if you don't always use let t = foo x in ... t .... t ... t ... then often
<mrvn>
flux: it would be helpfull with register allocation too. r.x ... f r; ... r.x. Can ocaml put r.x into a register across the function call or not?
<flux>
mrvn, ocaml already knows that
<pippijn>
more interestingly, if you know about deep immutability, you can parallellise expressions
<mrvn>
flux: how?
<flux>
for example: type r = { x : float }
<flux>
x can always be put into a register
<flux>
and with the other case, well if it inlines the functions it can learn that x isn't modified
<mrvn>
flux: unless type rm = { mutable xm : float; } let f x = let xm = Obj.magic x in x.xm <- 1.0
<flux>
..Obj.magic
<flux>
you already lost the game.
<flux>
mrvn, if I have a comon subexpressino I use a lot, I like to give it a name
<mrvn>
flux: I think such use works in ocaml and the compiler will never put r.x into a register across a function call
<flux>
that may be, but it would be within its rights
<flux>
it's really breaking the semantics quite badly if you go just Obj.magic anything
<mrvn>
flux: and I would like a way to tell the compiler that f is mean an breaks that.
<flux>
it's like complaining hat ocaml is broken because let 5 = (Obj.magic "hello") () crahes
<mrvn>
flux: conside the following: module M : sig type t = { x : int; } val incr : t -> unit end = struct type t = { mutable x : int; } let incr t = t.x <- t.x + 1 end
<mrvn>
flux: or abstract types in general
<mrvn>
the above could also be solved with type t = { private mutable x : int; } but ocaml doesn't allow that
<mrvn>
Does batteries actually have phantom type flavours for all the stdlib modules? Never checked them all.
err404 has quit [Remote host closed the connection]
<mrvn>
flux: any idea on my problem with '_a types?
<mrvn>
module M : sig type 'a t = private 'a list val make : unit -> 'a t end = struct type 'a t = 'a list let make () = [] end module N = struct let nil = M.make () end vs. module M : sig type 'a t = 'a list val make : unit -> 'a t end = struct type 'a t = 'a list let make () = [] end module N = struct let nil = M.make () end
<mrvn>
Why is nil : '_a M.t is M.t is private?
<mrvn>
s/is/if/
s_p1 has joined #ocaml
s_p has quit [Read error: Connection reset by peer]
Smerdyakov has joined #ocaml
emmanuel__ has quit [Read error: No route to host]
emmanuel__ has joined #ocaml
avsm has joined #ocaml
ftrvxmtrx_ has joined #ocaml
ftrvxmtrx has quit [Ping timeout: 276 seconds]
MaskRay has quit [Ping timeout: 245 seconds]
larhat has joined #ocaml
larhat has quit [Ping timeout: 256 seconds]
iago has joined #ocaml
avsm has quit [Quit: Leaving.]
Snark has quit [Quit: Quitte]
eni has quit [Quit: Leaving]
tonyg has joined #ocaml
Hussaind has quit [Quit: Konversation terminated!]
ftrvxmtrx__ has joined #ocaml
ftrvxmtrx_ has quit [Ping timeout: 265 seconds]
Smerdyakov has quit [Quit: Leaving]
<tonyg>
Lwt is awesome.
<pippijn>
it's ok
<pippijn>
for many things, it's great, for some things not so much
<mrvn>
Haven't used it enough to make a decision
<mrvn>
and it blocks on normal file io
<tonyg>
yeah, it'll be interesting scaling it up
<tonyg>
but experimenting with it is good fun
<tonyg>
pippijn: what are the things you think it's not so great for?
<pippijn>
letting it play together with ncurses
<tonyg>
ah, interesting
<tonyg>
i'm guessing judicious application of threads might work out?
<tonyg>
for such as file i/o and ncurses, etc.
<pippijn>
mrvn: but file io is a great application for a thing like lwt.. can't you make it async?
<mrvn>
pippijn: portably only with real threads.
<tonyg>
incidentally, which version of tuareg do people use with lwt?
<tonyg>
the lwt 2.3.2 patch doesn't apply clean to tuareg 2.0.4
<mrvn>
And when you use threads for IO and strings you need to copy all the data between the string and C buffers. Pretty wastefull and lwt doesn't do that.
<mrvn>
Imho IO should be done with bigarray.
<tonyg>
mrvn: does core unix not support iovec writing?
<tonyg>
i mean Unix
<tonyg>
maybe it doesn't. hmm.
<mrvn>
tonyg: core Unix does copy the data. don't think it has iovec
* tonyg
nods
<mrvn>
tonyg: The problem is the GC moving the string while the syscall reads/writes on it.
<tonyg>
eep. ok. no pinned regions? ... or is that what bigarray does
<mrvn>
tonyg: no pinned regions afaik. bigarray uses a buffer allocated outside the GC heap.
<tonyg>
cool. sounds like that's a sensible approach for io then
<pippijn>
mrvn: bigarray?
<pippijn>
is bigarray like mmap?
<mrvn>
pippijn: Part of the ocaml compiler libs
<mrvn>
pippijn: bigarray can do mmap but its not just that
<pippijn>
nice
bashi_bazouk has joined #ocaml
<bashi_bazouk>
Halp! I'm trying to build Ocsigen, but the PreCast module is missing from CamlP4!