jonafan has quit [Read error: 104 (Connection reset by peer)]
maskd- has joined #ocaml
sOpen has joined #ocaml
seafood_ has joined #ocaml
<sOpen>
anyone know a good place to read about hash variants? I don't even know if that's their real name -- types with ` (backtick) in front?
maskd has quit [Remote closed the connection]
<sOpen>
even just the proper name of the feature would help... the language manual doesn't say afaik. Is it hash variant? Google doesn't seem to think so...
<mrvn>
polymorphic variants?
Amorphous has quit [Read error: 110 (Connection timed out)]
<mrvn>
Manual 4.2 Polymorphic variants
<sOpen>
mrvn, thank you!
<sOpen>
that is it exactly
Amorphous has joined #ocaml
johnnowak has joined #ocaml
<johnnowak>
hello all. does anyone know where i can find information about pause times with ocaml's gc? i'm curious if it is suitable for soft real-time use
seafood has quit [Read error: 110 (Connection timed out)]
<thelema>
johnnowak: I don't know of any hard data, but if your memory usage grows without bound, ocaml's major collections will become unsuitable for soft real-time
<johnnowak>
yeah, that's what i figured. the requirements are fairly tight.. can't pause for more than 2-3ms really
<johnnowak>
a shame there doesn't seem to be a functional language that's suitable
<thelema>
does your memory requirements really grow without bound?
<johnnowak>
no, they won't be
<thelema>
of course in ocaml, you can architect your code so that short-lived objects always fit in the minor heap, and with proper use of Ancient to move long-lived data out of GC'ed memory, you can get fast major collections
<johnnowak>
Ancient?
<johnnowak>
ah, i'll have a look at that
<johnnowak>
thanks
ched_ has joined #ocaml
Ched has quit [Read error: 110 (Connection timed out)]
<mrvn>
copying GC and realtime usualy don't mix.
maskd- is now known as maskd
<palomer>
someone once wrote a functional programming language without a GC
<palomer>
I kid you not!
<palomer>
functions had to return the resources which were no longer being used
<mrvn>
Sure, why not.
<mrvn>
If you forbid self recursive data structures then you can do reference counting
<mrvn>
Anything else and you run into the problem of leaks or dangling pointers.
<palomer>
you'd have to forbid any kind of recursive data structures, no?
<mrvn>
type 'a tree = Nil | Node of tree * 'a * tree
<mrvn>
recursion like that is ok. Just cycles are forbidden.
<palomer>
don't you mean 'a tree = Nil | Node of 'a tree * 'a * 'a tree ?
<mrvn>
yes
<mrvn>
You can have recursive types but not recursive data.
<mrvn>
or cyclic data
<palomer>
without references, I don't see how you could get cycles
<mrvn>
palomer: let rec cycle = Node (cycle, 1, cycle)
<palomer>
cycle evaluates to bottom
<palomer>
that's an infinite loop!
<mrvn>
That would cause cycle to have a minimum reference count of 2.
<mrvn>
can never reach 0 so the memory is leaked when no longer used.
<palomer>
try writing that in the toplevel
<mrvn>
palomer: perfectly fine in ocaml.
<palomer>
let rec a = 2 :: a <-- easier
<palomer>
oh my
<palomer>
ehh???
<mrvn>
palomer: a is a block of size 2 containing the int 2 and the value (pointer to) a.
<palomer>
but it needs to evaluate cycle
<mrvn>
no.
<mrvn>
a isn't evaluated.
<mrvn>
> let rec a () = :: (a ());;
<palomer>
let rec a () = a () in a ();;
<mrvn>
No bot?
<mrvn>
let rec a () = 2 :: (a ());;
<mrvn>
# a ();;
<mrvn>
Stack overflow during evaluation (looping recursion?).
<palomer>
see!
<mrvn>
Only works if a is not evaluated.
<palomer>
but...how does ocaml decide what to evaluate and what not to evaluate?
<palomer>
doesn't this make ocaml a little lazy?
<johnnowak>
palomer: 'a' is already a value, it can't be reduced any further
<mrvn>
palomer: Anything that is 'a but not 'a -> 'b is never evaluated
<palomer>
ahhh, righto!
<palomer>
values are not reduced
<johnnowak>
aye. nothing to do with laziness.
<palomer>
and I've been avoiding that kind of code for ages!
<johnnowak>
you can create a cycle with a closure as well
<palomer>
johnnowak, how so?
<mrvn>
johnnowak: how? That would always require an evaluation.
<johnnowak>
(define (x) (lambda (y) x))
<mrvn>
let x = fun y -> x?
<mrvn>
# let rec x = fun y -> x;;
<mrvn>
Error: This expression has type 'a -> 'b but is here used with type 'b
<mrvn>
That requires -rectypes.
<johnnowak>
that's not equivalent
<mrvn>
# let rec x = fun y -> x;;
<mrvn>
val x : 'b -> 'a as 'a = <fun>
<johnnowak>
(define (x) (lambda (y) x)) is more like
<mrvn>
The thing is that x is function, meaning code, there and not dynamically allocated.
<johnnowak>
let rec x a = fun y -> x ;;
<johnnowak>
i don't understand why that won't type check
<mrvn>
johnnowak: huh? Where do you get the a from?
<johnnowak>
mrvn: (define (x) ...) declares a procedure 'x' that takes no arguments
<mrvn>
johnnowak: recursive type
<mrvn>
johnnowak: doesn't it define a value that may or may not be a function?
<johnnowak>
mrvn: no, it always defines a procedure
<mrvn>
(define (x) 1)
<johnnowak>
(define (x) 1) == (define x (lambda () 1))
<mrvn>
(+ x 1) -> 2?
<johnnowak>
nope
<johnnowak>
(define (x) 1) (x) == 1
<johnnowak>
the (define (f) ..) form is shorthand for (define f (lambda () ... ))
<mrvn>
ahh
<mrvn>
long time since I wrote scheme.
<johnnowak>
sorry about that
<johnnowak>
in any case, i don't see why a recursive type is needed
<mrvn>
# let rec x () = fun y -> x ;;
<mrvn>
val x : unit -> 'b -> 'a as 'a = <fun>
<johnnowak>
the same function type checks fine in haskell
<johnnowak>
> let f x = \y -> x
<johnnowak>
f :: t -> t1 -> t
<mrvn>
Because the result type is the same as the full type.
<mrvn>
johnnowak: > let f x = \y -> f
<johnnowak>
ack
<johnnowak>
obviously
<mrvn>
what type has that is haskell?
<johnnowak>
occurs check error, yes
<mrvn>
johnnowak: in ocaml -rectypes you get: # let rec f x = f;;
<mrvn>
val f : 'b -> 'a as 'a = <fun>
<johnnowak>
yeah, i know rectypes
<palomer>
the argument eater!
<mrvn>
The ('b -> 'a) as 'a syntax hides errors so generally it isn't allowed.
<johnnowak>
aye.
<palomer>
I remember proving that the argument eater is untypeable
<palomer>
so...is there a function that types in haskell and not ocaml?
<mrvn>
worstcase you have to define some explicit types.
<johnnowak>
palomer: ocaml doesn't have higher rank types
<palomer>
but I mean in this case
<johnnowak>
no, haskell can't type it either because of the occurs check
<johnnowak>
you need equirecursive types
sOpen has quit [Read error: 110 (Connection timed out)]
<johnnowak>
not sure why my brain melted there.. sorry about that
<palomer>
let f x = \y -> x seems like a pretty useless function
<mrvn>
palomer: case of an example being simplified into the part that fails.
sOpen has joined #ocaml
<johnnowak>
palomer: that's a useful function. it essentially lifts an object to a function that always returns that object. it's actually pre-defnined in the haskell prelude as "const"
<sOpen>
I am writing a program that uses bounding boxes in a plane. I would like to work with both float-based bounding boxes and num-based bounding boxes. What's the best way to support both with as little code duplication as possible?
<sOpen>
I looked at variant types but they are too strict, still. Objects?
<mrvn>
how are they too strict?
<sOpen>
mrvn, I can't make nice polymorphic functions over them. At some level, I need to do either float math or num math and those types bubble up.
<sOpen>
unless there is something that I am missing (likely, am noob)
<mrvn>
you have to use the variant type as input and match them
<sOpen>
mrvn, erm... perhaps I mis-spoke. I have: type 'a bbox = BBox of 'a point * 'a point;; i mean to say "parameterized type" not variant (though it is)
<mrvn>
you need type point = Float of float or Num of num
<sOpen>
i have: type 'a point = 'a * 'a... I should make this a variant type?
<sOpen>
aha... i understand. hrm, thank you, mrvn
<mrvn>
if you want functions that take floats and num points then yes.
<sOpen>
yes... i was working at the wrong level
<mrvn>
alternatively you can have a type 'a box_ops = { plus : 'a -> 'a -> 'a; minus : 'a -> 'a -> 'a; ...} and pass that to your functions along with the 'a BBox.
<palomer>
thelema, ok, define plus for a pair of ints or a pair of floats
<thelema>
the problem is that overloading doesn't work with type inference
<thelema>
especially:
<thelema>
let plus (x:int) (y:float) = (float x) +. y
<thelema>
palomer: Didn't I just define [plus] for int and float?
<palomer>
let plus (a,b) (c,d) = (a+c,b+d) <--untypeable
<johnnowak>
thelema: overloading works with inference in haskell, no?
<thelema>
it sort-of works in F#, but the types are known at runtime
<johnnowak>
even the plus (x:int) (y:float) example works in haskell
<thelema>
I think haskells typeclasses fill in the overloading gap, not overloading
<mrvn>
palomer: You wouldn't overload but pass along the arithmetic functions as argument.
<palomer>
oh, I see thelema's point
<johnnowak>
thelema: it is overloading. you can define multiple functions with the same name.
<mrvn>
johnnowak: that isn't overloading. that just binds values
<mrvn>
johnnowak: shadowing
<johnnowak>
i'm not talking about that
<palomer>
johnnowak, you're talking about type classes?
<thelema>
mrvn: okay, so you'd need some different syntax to do this.
<johnnowak>
yes
<palomer>
johnnowak, but then you need some extra help for inference
<johnnowak>
type classes allow you to define multiple functions with the same name where the correct function is chosen based on the types involved
<palomer>
like functional dependencies
<thelema>
to build/extend a family of functions with the same name
<johnnowak>
palomer: sometimes, but you still have inference
<mrvn>
johnnowak: no. just allows you to write functions that take objects of a certain type
<johnnowak>
mrvn: no what?
<mrvn>
johnnowak: And the functions are chosen based on the hash of the name and a virtual table.
<thelema>
once you have a value that's part of a typeclass, it carries along with it a dictionary of functions to be called as needed, no?
<palomer>
let fun x y = x#plus y <----kind of overloading (imho)
<mrvn>
johnnowak: type classes don't define multiple functions with the same name
<johnnowak>
mrvn: the result is a single function, but it's built up from multiple type-specific definitions
<palomer>
thelema, yeah, kind of like box_ops defined earlier
<mrvn>
palomer: overloading would mean you have 2 definitions of a function with different types and depending on the argument types one of them is chosen.
<johnnowak>
mrvn: how is that not what type classes are?
<palomer>
mrvn, right, so depending on the type of x, a different plus method would be called
<mrvn>
With type classes all implementations must have the same type.
<thelema>
My overloading would have no runtime penalty, but would require annotations in the hard cases
<johnnowak>
i define add :: Int -> Int -> Int and add :: Float -> Float -> Float
<johnnowak>
and it picks the correct one
<mrvn>
palomer: that isn't overloading.
<palomer>
by your definition it is!
<mrvn>
palomer: in all cases x.virtual_table[hash "plus"] is chosen.
<palomer>
good point
<mrvn>
palomer: overloading would be depending on the type of y in x#plus y
<palomer>
I always wondered what would happen if two strings returned the same hash value
<mrvn>
palomer: bad things.
<johnnowak>
mrvn: it's not necessary to implement type classes with a dictionary. you could pick all of the correct functions statically given suitable restrictions
<mrvn>
johnnowak: no.
<thelema>
palomer: the ocaml hash is guaranteed not to collide for short strings, IIRC
<johnnowak>
yes!
<palomer>
so ocaml is based on the fact that hash is injective?
<mrvn>
johnnowak: there are no such restrictions in ocaml
<palomer>
thelema, how short?
<thelema>
<8 chars, iirc
<johnnowak>
mrvn: i'm not talking about ocaml
<mrvn>
johnnowak: but we are
<palomer>
but method names can be of any length
<johnnowak>
is ocaml the standard for what counts as overloading?
<palomer>
(ditto for variants)
<mrvn>
johnnowak: ocaml has no overloading
<johnnowak>
i know.
<mrvn>
palomer: I wonder if the compiler even checks for collisions.
<palomer>
me too!
* thelema
would declare Ada the standard for overloading. They did overloading right there.
<palomer>
thelema, I can't parse your second sentence
<johnnowak>
i can't parse any of this nonsense
<palomer>
I have to agree with johnnowak, type classes look like overloading (syntactically)
<thelema>
The creators of Ada did overloading correctly when they designed it.
<palomer>
ahh
<mrvn>
Sometimes I miss that you can't write let plus x y = x + y 'meta |' x +. y;; plus : int -> int -> int | float -> float -> float
<palomer>
(they did overloading right) there
<thelema>
nope, it's not 8 chars -- `jagJhn and `oZshTt collide
<palomer>
and not "they did overloading (right there)"
<johnnowak>
palomer: they are overloading for a common definition of overloading. i've no idea what definition mrvn is using.
<palomer>
ahh, the compiler checks for the rare cases
<palomer>
phew
<mrvn>
Error: Variant tags `jagJhn and `oZshTt have same hash value.
<mrvn>
Change one of them.
<mrvn>
nice.
<palomer>
and all this time I thought that ocaml was slightly incorrect
<mrvn>
I wonder if the compiler catches such a collition if they are in different modules.
<palomer>
but would it matter?
<mrvn>
if you pass variant types between the modules
<palomer>
johnnowak, maybe mrvn is trying to say that overloading a compile-time kind of beast
<palomer>
how would this cause a problem?
<johnnowak>
palomer: and type classes can be entirely resolved at compile time given a whole program compiler
<johnnowak>
see jhc
<palomer>
johnnowak, really??
<thelema>
there's a check at link time for variant tag collisions
<johnnowak>
yes
<mrvn>
I'm saying that type classes don't do overloading
<johnnowak>
mrvn: what is your definition of overloading?
<palomer>
wait...
<mrvn>
johnnowak: "Method overloading is a feature found in various programming languages such as Ada, C#, C++, D and Java that allows the creation of several methods with the same name which differ from each other in terms of the type of the input and the type of the output of the function."
<thelema>
n/m, compile time.
<palomer>
so you can't write code like: weird func :: () -> IO (printable) = do {x <- get_user_input; if x = "hello" then return 6 else return "boom"} ???
<mrvn>
type classes only allow having different objects with ONE method with ONE type.
<palomer>
err
<palomer>
make that printable y => () -> IO y
<johnnowak>
mrvn: all of the 'foo' functions you define have to have a similar type, yes, but each function provided for each instance has a different type
<mrvn>
johnnowak: there is only one method per class.
<mrvn>
johnnowak: and each has the type the type class specified.
<palomer>
The basic idea is that instead of passing a dictionary, a case statement directly scrutinizes the type parameter of a function and calls the appropriate overloaded routine directly.
<palomer>
err, there's a case statement, that's pretty run time to me
<johnnowak>
mrvn: each instance of 'Eq' has to define an 'eq' function, but each instance can give a different function. the function given can have the type Foo -> Foo -> Bool, Bar -> Bar -> Bool, etc
<johnnowak>
it seems like a restricted form of overloading to me
<palomer>
but the function is not decided at compile time
<johnnowak>
SHGaDGH
<johnnowak>
who cares!
<mrvn>
johnnowak: no. each class has only one method eq. And they all have to conform to the type classes type.
<thelema>
for me, overloading = compile-time dispatch based on function parameter / return types
<johnnowak>
palomer: and as i said, it can be done at compile time
<mrvn>
johnnowak: can't in general
<palomer>
johnnowak, not in haskell
<johnnowak>
fuck
<palomer>
jhc doesn't do it
<johnnowak>
palomer: jhc does not do dictionary passing
<palomer>
it has a case statement
<johnnowak>
you need that for certain extensions like polymorphic recursion, but i don't think you do for haskell 98
<mrvn>
thelema: and how would you do that with polymorphic functions?
<johnnowak>
mrvn: you do realize each instance of a class can provide its own 'eq' function, right?
<palomer>
ok, that's it, im gonna attempt to write some haskell code!
<mrvn>
thelema: at compile time the polymorphic function wouldn't know what type it gets as argument so it can't decide what overloaded code to call.
<mrvn>
johnnowak: that still is not "several methods". That is exactly one method.
<palomer>
who am I kidding, I don't know how
<johnnowak>
i can write add_int. and I can wrote add_float. and i can make 'add' that picks between add_int and add_float depending on the types involved.
<palomer>
let y :: IO (printable) = do {x <- get_user_input; if x = "hello" then return 6 else return "boom" in print y
<mrvn>
johnnowak: nope
<palomer>
let y :: IO (printable) = do {x <- get_user_input; if x = "hello" then return 6 else return "boom"} in print y
<palomer>
(sorry, forgot a })
<johnnowak>
mrvn: of course i can.
<johnnowak>
if you're drawing some clever distinction here, you might as well explain it rather than saying 'no.' over and over again
<mrvn>
johnnowak: you can't write an add that takes either an int or a float. That requires wrapping the int or float into another type like Int of int | Float of float or `Int of int | `Float of float.
<johnnowak>
mrvn: you do realize i'm talking about haskell, yes?
<johnnowak>
and type classes?
<mrvn>
johnnowak: no. this is #ocaml so why would I assume you talk about haskell?
<johnnowak>
because that's what the conversation was about.
<johnnowak>
mrvn: johnnowak: type classes don't define multiple functions with the same name
<johnnowak>
palomer: I have to agree with johnnowak, type classes look like overloading (syntactically)
<johnnowak>
mrvn: I'm saying that type classes don't do overloading
<johnnowak>
etc
<johnnowak>
gee, I wonder why I would think we're talking about type classes.
<mrvn>
In ocaml type classes don't even define a simple function or method let alone overloading.
<johnnowak>
since when does ocaml have type classes?
<johnnowak>
ocaml does not have type classes
<mrvn>
since you can write class type foo ...
<johnnowak>
ocaml does not have type classes
<palomer>
those are class types! not type classes
<johnnowak>
[11:47pm] thelema: I think haskells typeclasses fill in the overloading gap, not overloading
<johnnowak>
[11:48pm] johnnowak: thelema: it is overloading. you can define multiple functions with the same name.
<johnnowak>
[11:48pm] mrvn: johnnowak: that isn't overloading. that just binds values
<johnnowak>
[11:48pm] mrvn: johnnowak: shadowing
<johnnowak>
the conversation topic was completely clear
<johnnowak>
and mrvn's responses are completely nonsensical
<mrvn>
johnnowak: that was about defining plus several times, not about haskells typeclasses
<palomer>
oh wait...the classic example
<johnnowak>
forget this, i'm not going to waste time with the functionally illiterate
<palomer>
I was talking about haskell type classes
<palomer>
but, erm, for a seasoned ocaml coder I see where the confusion could arise
<johnnowak>
everyone was. even mrvn was, until he discovered he was wrong, and then started making things up to hide it
<palomer>
no need to get nasty!
<mrvn>
I don't have a clue about haskell and was never talking about it
<johnnowak>
i wouldn't get nasty if the conversation didn't consist of a rude 'no.' thrown at me repeatedly
<palomer>
right, mrvn probably took my objects as examples
<mrvn>
anyway, we all now now that discussion threads got mixed up. Leave it at that
<mrvn>
+k
<palomer>
right, mrvn doesn't seem like the type who would lie about such a thing
<palomer>
I find it odd that jhc would allow polymorphic recursion at the cost of having a case statement for type classes
<johnnowak>
palomer: there are other things, like existentials
<palomer>
I would have thought jhc to stick to haskell98
<johnnowak>
i'd imagine it can do without any case statement most of the type. it's a question of code size as well
<johnnowak>
palomer: jhc supports gadts which certainly aren't haskell 98
<palomer>
whoa, that's news
* palomer
doesn't like the way gadts are implemented in ghc
<johnnowak>
i'm off.
johnnowak has left #ocaml []
<palomer>
well... that was an enlightening conversation
<palomer>
night!
seafood_ has quit [Read error: 145 (Connection timed out)]
seafood has joined #ocaml
Camarade_Tux has joined #ocaml
ched_ is now known as Ched
jeanbon has joined #ocaml
Yoric[DT] has quit ["Ex-Chat"]
jeanbon has quit [Client Quit]
fbvortex has joined #ocaml
<fbvortex>
is there a way to tell what lines in the code provided the information for the type inference for an expression? I'm getting a "this expression has type...but is here used with type..." error, and I don't see the inconsistency after poring over the code...
<flux>
unfortunately no
<flux>
but, do you perchance happen to use emacs?
<flux>
if so, you may want to compile the source with -dtypes
<flux>
after which you can go over an expression and hit C-c C-t to find out its inferred type
<flux>
third option: in the area where you have type issues, annotate expressions explicitly
<flux>
say, your problem is in the other branch of an if: annotate the other branch too
<fbvortex>
thanks flux. I don't use emacs, but let me try your annotator. can you explain what you mean by annotating explicity? do you mean in a comment?
<flux>
let f a b = a + b -> let f (a : int) (b : int) : int = (a + b : int)
gl has joined #ocaml
<flux>
or if we go all the way: let f (a : int) (b : int) : int = ((( + ) : int -> int -> int) (a : int) (b : int) : int)
<flux>
but that's obviously overkill :)
<fbvortex>
flux: OK, I see exactly what you mean now. it makes sense.
gl has quit [Client Quit]
Associat0r has quit []
gl has joined #ocaml
<mrvn>
When you do it manualy doing it for a few spots usualy is sufficient.
<fbvortex>
Hm, I think the problem is that I have nested match expression; what's the correct syntax to insulate the nested match whose code is above it from the clause below it?
<mrvn>
() or being/end
<fbvortex>
thanks, that was the problem.
<fbvortex>
For some reason, I hadn't seen/used the -dtypes option before.
seafood has quit [Read error: 60 (Operation timed out)]
seafood has joined #ocaml
mishok13 has joined #ocaml
komar_ has joined #ocaml
maskd has quit [Read error: 60 (Operation timed out)]
maskd has joined #ocaml
monadic_kid has joined #ocaml
<fbvortex>
thanks again flux, mrvn.
fbvortex has quit [Remote closed the connection]
seafood has quit [Read error: 104 (Connection reset by peer)]
seafood has joined #ocaml
ygrek has joined #ocaml
monadic_kid has quit ["Leaving"]
LeCamarade has joined #ocaml
Alpounet has joined #ocaml
s4tan has joined #ocaml
Alpounet has quit ["Quitte"]
_zack has joined #ocaml
Alpounet has joined #ocaml
monadic_kid has joined #ocaml
munga_ has joined #ocaml
<munga_>
I want to write a stub for a polymorphic function to dynlink a module at runtime ... http://pastebin.com/m75abe0b9
<munga_>
how can I type this expression correctly ?
<mfp>
munga_: type poly = { mutable f : 'a 'b. ('a -> 'b) -> 'a list -> 'b list } let f = { f = fun _ _ -> failwith "stub" }
<petchema_>
munga: you forgot "ref" at the end of type in the .mli
<mfp>
update with f.f <- .... in the dynlinked module, apply with f.f
<mfp>
petchema_: the ref is invariant, so it wouldn't work anyway (notice the weak types)
<petchema_>
mfp: mmh yes, I didn't try to actually compile it
<munga_>
petchema_: yes I forgort ref ... and yes this can't be done. I've to create a record type and have a filed like 'a . (('b -> 'a) -> 'b list -> 'a list) ref ...
<munga_>
would this work ?
<mfp>
munga_: you're almost there, but the ref breaks it; just use a mutable field as I showed above
<petchema_>
munga: you don't need ref if the field is already mutable
<petchema_>
(basically type 'a ref = { mutable contents: 'a } )
<munga_>
thanks ! http://pastebin.com/m796c0847 this should be it . I hope this will play well with Dynlink ... I guess I'm going to have a ref to the entire record and then late bind it ...
rjack has joined #ocaml
monadic_kid has quit ["Leaving"]
rjack has quit ["leaving"]
seafood has quit [Read error: 110 (Connection timed out)]
sOpen has quit [Read error: 110 (Connection timed out)]
<kaustuv>
flux: better not to promote the deprecated -dtypes form of the option, I think.
rjack has joined #ocaml
_zack has quit [Read error: 131 (Connection reset by peer)]
_zack has joined #ocaml
jeanbon has quit [Read error: 113 (No route to host)]
rjack has quit ["leaving"]
rjack has joined #ocaml
rjack has quit [Client Quit]
<flux>
kaustuv, -dannot is the new one then?
<flux>
because I remembered it the other way..
komar_ has quit [Read error: 54 (Connection reset by peer)]
<mfp>
flux: -annot
<mfp>
(is the new one)
<flux>
ooh, I hadn't known about that
<flux>
too new for me :)
<flux>
apparently in 3.11 then
<flux>
I still use 3.10 quite a lot
<noj>
anyone with a nice vim-setup for O'Caml development, that would like to share their config file(s)?
verte has joined #ocaml
_andre has joined #ocaml
rjack has joined #ocaml
Yoric[DT] has joined #ocaml
Camarade_Tux_ has joined #ocaml
rjack has quit ["leaving"]
Mr_Awesome has quit [Read error: 110 (Connection timed out)]
Mr_Awesome has joined #ocaml
Camarade_Tux has quit [Read error: 110 (Connection timed out)]
mihamina1 has joined #ocaml
<mihamina1>
Hi all,
<mihamina1>
I would like to have the date since Unix epoch and I dont have Batteries installed.
<mihamina1>
How would you suggest to do?
<Camarade_Tux_>
Unix.time () =)
<mihamina1>
of course... the problem is searching with "ocaml date epoch" point to the Batteries Date module...
<mihamina1>
thank anyway
<Camarade_Tux_>
you're welcome :)
<mihamina1>
so you're there... they created batteries because there is not enough features in the core ocaml, right?
<mihamina1>
what has been the advantage of creating a separate project (batteries) insteand of including their work directly inside the core?
<Camarade_Tux_>
the goal is to pack most things, and more consistently, on a default installation of ocaml (or to have only one thing to install to get everything)
<Camarade_Tux_>
that wouldn't have gone in the core
<Camarade_Tux_>
batteries is much bigger than a standard library, it has many addiotinal libraries (for gzip and bzip2 for instance)
<mihamina1>
uh ok...
<mihamina1>
I think they should have put the batteries in the core, and it would have been distribution packagers work to split them
<mihamina1>
well.... huge debate
Mr_Awesome has quit [Read error: 110 (Connection timed out)]
<mihamina1>
and I am far for having the level to have high level discussion with OCaml gurus :-)
<Camarade_Tux_>
the core is managed by inria and since manpower is not infinite, I find it's better not to waste inria's
Mr_Awesome has joined #ocaml
<thelema>
mihamina1: the core code is maintained by INRIA - they don't have the resources...
<thelema>
and because of wierd copyright reasons, they won't turn over ownership of the code to the community
<mihamina1>
aaaaaaah ok. I understand
<thelema>
ownership isn't the right word, but maybe you get the point
<mihamina1>
I got it thank you
<flux>
in any case, batteries is a big, not fully backwards compatible step
<thelema>
look up caml consortium
Jedai has quit ["KVIrc Insomnia 4.0.0, revision: , sources date: 20090115, built on: 2009/03/07 00:45:02 UTC http://www.kvirc.net/"]
fremo has quit [Remote closed the connection]
fremo has joined #ocaml
fremo is now known as Guest56751
<kaustuv>
thelema: the standard library is LGPL
<kaustuv>
But INRIA would like to maintain ownership of it to keep companies such as Microsoft (who are in the CC) happy
<thelema>
yes, but inria would have to own the copyright on the code to continue their "caml consortium"
<thelema>
and they've decided there's some problems with copyright xfer from non-frenchies
<kaustuv>
That's true, there are.
<Camarade_Tux_>
IANAL but I think gpl isn't even ok with the french law (or at least the copyright attribution part)
<kaustuv>
Strictly speaking you can fork a free version of the stdlib and let the marketplace of ideas work out which it prefers.
<thelema>
Camarade_Tux_: I don't know of any copyright attribution part of the GPL
<Camarade_Tux_>
thelema, absolutely, my sentence was wrong : the copyright attribution is not part of the gpl, what I had in mind was what FSF asks you to do (or attributing copyright to INRIA)
<thelema>
kaustuv: that was to be my part of the batteries project. It's back-burnered at the moment.
<kaustuv>
The FSF only requires you to assign copyright to the FSF in order to contribute to GNU software
seafood has joined #ocaml
jeddhaberstro has joined #ocaml
Guest56751 has quit [Remote closed the connection]
fremo has joined #ocaml
fremo is now known as Guest6616
willb1 has joined #ocaml
<mihamina1>
would you know any piece of code that would allow some kind of cursor in the interactive toplevel (when launching "ocaml" just at console prompt)
<mihamina1>
I make many typo errors, and backspace is too much destructive
<flux>
mihamina1, rlwrap or ledit
<flux>
mihamina1, you use it like: rlwrap ocaml, and suddenly your ocaml has a readline wrapped around it
<mihamina1>
wa! awsome
<mihamina1>
flux: thank you very much
<mihamina1>
it's magic
<mihamina1>
I might ask too much... and for modules and built-in function names completion?
<mihamina1>
such as print_string,...
<mihamina1>
is there something?
<flux>
there is enhtop
<flux>
I don't remember what everything it does
<flux>
but it might still make your life easier
<flux>
(I've never used it)
verte has quit ["~~~ Crash in JIT!"]
Guest6616 is now known as fremo
sporkmonger has joined #ocaml
bombshelter13_ has joined #ocaml
seafood has quit []
<mihamina1>
flux: enhtop, it's an entire Ocaml patch...
<flux>
correct
willb1 has quit ["Leaving"]
jamii has quit [Read error: 110 (Connection timed out)]
s4tan has quit []
<mihamina1>
I want to create a function print_list: string list -> string
<mihamina1>
and I do this:
<mihamina1>
let aux x y = x^y^" " in let print_liste = List.fold_left aux "" ;;
<mihamina1>
Syntax error
<mihamina1>
what is my error?
<mihamina1>
cant find
<mrvn>
mihamina1: only the top let can be without in
<mrvn>
plus you have it the wrong way around: # let print_liste = let aux x y = x^y^" " in List.fold_left aux "" ;;
<mrvn>
val print_liste : string list -> string = <fun>
<mihamina1>
# let print_liste = let aux x y = x^y^" " in List.fold_left aux "" ;;
<mihamina1>
val print_liste : string list -> string = <fun>
<mihamina1>
bingo
<mihamina1>
thank you mrvn
<mihamina1>
I too much think like "speaking" to Ocaml
fremo has quit [Remote closed the connection]
<mihamina1>
need time to get used
fremo has joined #ocaml
fremo is now known as Guest40926
Guest40926 has quit [Read error: 54 (Connection reset by peer)]
fremo has joined #ocaml
fremo is now known as Guest49790
<munga_>
how can I generate cmxs with ocamlbuild ?
LeCamarade has quit ["Gone."]
Guest49790 is now known as fremo
<kaustuv>
munga_: ocamlbuild something.native instead of something.byte generally.
<munga_>
kaustuv: you need to pass -shared to ocamlopt somehow and it seems there is not default rule for ocamlbuild to do so ...
<munga_>
does anybody have the myocamlbuild rule to build cmxs ?
Yoric[DT] has quit [wolfe.freenode.net irc.freenode.net]
_andre has quit [wolfe.freenode.net irc.freenode.net]
ulfdoz has quit [wolfe.freenode.net irc.freenode.net]
mbishop has quit [wolfe.freenode.net irc.freenode.net]
authentic has quit [wolfe.freenode.net irc.freenode.net]
ozzloy has quit [wolfe.freenode.net irc.freenode.net]
olegfink has joined #ocaml
<olegfink>
hi, any word from jane street?
ozzloy has joined #ocaml
authentic has joined #ocaml
Yoric[DT] has joined #ocaml
_andre has joined #ocaml
Associat0r has joined #ocaml
bohanlon has joined #ocaml
<Camarade_Tux_>
flux, I remember you complained about godi's speed, did you modified it to improve its performance or have I been dreaming ?
mbishop has joined #ocaml
fremo has quit [Remote closed the connection]
fremo has joined #ocaml
jah has joined #ocaml
fremo is now known as Guest41825
<flux>
camarade, I only implemented searching to the interactive console
kaustuv has quit ["ef1212fd1d780ee1cc015e69b76ad663"]
|Lupin| has joined #ocaml
<Camarade_Tux_>
flux, ok, so I was actually dreamnig ;p
<|Lupin|>
hello there !
<|Lupin|>
I'm looking for code to load an RSA public key from a .der file. Could someone help with that, please ?
<|Lupin|>
(I've looked in cryptokit and the bindings for ssl that are packaged for debian and couldn't find such a function)
<Camarade_Tux_>
I've been planning a package manager for windows for a long time and should start it soon, after mixing everything I wanted (I want to ease cross-compilation so I'll be playing on linux/unix/* too) and I realized pkgsrc basically as that ; godi is based on pkgsrc ;)
<Camarade_Tux_>
|Lupin|, I don't know cryptokit nor .der files but don't you basically just need to read the file as a string ?
<|Lupin|>
Camarade_Tux_: no, I don't think so... DER files use asn1 syntax and it seems that, although they are simple, they are not _that_ simple, unfortunately
<hcarty>
munga_: Thanks for the cmxs rule
jah has quit []
Guest41825 has quit [Remote closed the connection]
fremo has joined #ocaml
fremo is now known as Guest53555
hkBst_ has joined #ocaml
hkBst has quit [Read error: 131 (Connection reset by peer)]
hkBst_ is now known as hkBst
_zack has quit ["Leaving."]
dabd has joined #ocaml
jonafan has joined #ocaml
sOpen has joined #ocaml
Yoric[DT] has quit ["Ex-Chat"]
<palomer>
is there an application to automatically format code?
Alpounet has joined #ocaml
jeanbon has joined #ocaml
jeanbon has quit [Client Quit]
<hcarty>
palomer: Emacs+tuareg or camlp4?
jonafan_ has joined #ocaml
jonafan has quit [Nick collision from services.]
jonafan_ is now known as jonafan
<palomer>
tuareg can automatically format?
<palomer>
how?
<palomer>
it can indent
<palomer>
but I've never seen it format
<brendan>
indent-region ?
<palomer>
that only indents
<palomer>
camlp4 can pretty print code?
<brendan>
I don't know what you mean by format
<Alpounet>
neither do I
<palomer>
indent and put newlines where needed
<palomer>
like, make it pretty
<Alpounet>
palomer > search about #install_printer
rjack has joined #ocaml
<palomer>
#install_printer lets me tell ocaml how to print my code (in the toplevel)
<palomer>
I want something to read my code and spit out a prettier version
<hcarty>
palomer: camlp4 may not be "prettier", but it will/can do what you are asking
<hcarty>
Alpounet: I heard back from Olivier Andrieu, the Cairo-OCaml developer
<hcarty>
Alpounet: He said the best way to contribute would be to request an account on fd.o and join the project that way
<hcarty>
So it looks like that may be a better approach than bringing it in to New Hope
<hcarty>
He did say that he is not actively maintaining the bindings
<brendan>
palomer: you could try a combination of fill-individual-paragraphs; indent-region
<brendan>
hmm, that needs tweaking
Guest53555 has quit [Remote closed the connection]
fremo has joined #ocaml
fremo is now known as Guest74466
jeanbon has joined #ocaml
<Alpounet>
hcarty, hmm
<Alpounet>
it he doesn't maintain it anymore, he should let us work on it
<Alpounet>
but it looks like he develops it a bit, still
_zack has joined #ocaml
<palomer>
its his baby!
javax_ has quit [Read error: 110 (Connection timed out)]
sOpen has quit [Read error: 110 (Connection timed out)]
<hcarty>
I'll discuss it with kaustav, and try to get a fd.o account some time soon
<hcarty>
I'd prefer not to start the project with a hostile takeover of a project :-)
<hcarty>
If there are problems then development can be moved over
zstars has quit [Read error: 104 (Connection reset by peer)]
nagnatron has joined #ocaml
zstars has joined #ocaml
komar_ has joined #ocaml
rjack has quit ["leaving"]
<gildor>
hcarty, kaustuv: you want a git repo for cairo-ocaml in newhope project ?
ygrek has quit [Remote closed the connection]
<hcarty>
gildor: I'm not sure. It may be less disruptive to continue maintaining the project at fd.o
<hcarty>
Though it would be nice to move it from their CVS to their git repository
<hcarty>
kaustuv: Your thoughts?
ofaurax has joined #ocaml
<gildor>
hcarty: well as for everything that touch OCaml, I think you'll have more chance to find interested maintainer with newhope (hosted on OCaml forge) than to stay on freedesktop which is mostly about C/python
<hcarty>
gildor: I agree. But I don't want to step on the toes of the code's original author
<hcarty>
gildor: Perhaps there should be an "outside programs and modules" section on the forge?
<gildor>
hcarty: is cairo-ocaml a separate package from cairo ?
<hcarty>
gildor: It could link to projects such as the Cairo bindings, bitstring, ocamlgsl, etc which are hosted elsewhere
<hcarty>
gildor: It is separate
<gildor>
hcarty: well if it is separate and "He is not maintaining the bindings any longer", you can reasonably ask him if he don't mind rehosting it in newhope
ofaurax has quit ["Leaving"]
<gildor>
hcarty: just ask him
Elrood has joined #ocaml
<gildor>
concerning the "outside programs and modules" section on the forge, it is not the point of the forge (but maybe of other services that can be hosted)
<gildor>
the forge is not a 2nd hump ;-)
<hcarty>
gildor: Fair enough :-)
<gildor>
hcarty: if you decide to ask him, could you cc:newhope-devel@lists.forge.ocamlcore.org ?
_andre has quit ["leaving"]
<hcarty>
gildor: Certainly
<palomer>
hrmph
<palomer>
how can I use camomile to get the value of "ctr-c" ?
<aij>
argh, ocaml's subtyping seems to be breaking, but I'm having trouble reproducing it in a smaller example
<aij>
Basically, I'm getting Error: The implementation cfg.ml does not match the interface cfg.cmi:
<aij>
<huge signatures>
<aij>
Values do not match:
<aij>
val nb_vertex : (G'.t, Ast.stmt list BM.t, '_a) pcfg -> int
<aij>
is not included in
<aij>
val nb_vertex : t -> int
sOpen has joined #ocaml
javax has joined #ocaml
<mrvn>
and t isn't (G'.t, Ast.stmt list BM.t, '_a) pcfg?
<aij>
of course, type t = (G'.t, Lang.t BM.t, V.t LM.t) pcfg, and Lang.t is Ast.stmt list
<aij>
so if I change let nb_vertex = w1 G'.nb_vertex to let nb_vertex : t->int = w1 G'.nb_vertex it stops complaining about nb_vertex and complains about the next function...
<mrvn>
so the error is in the next function
<aij>
mrvn: I'm pretty sure I could just keep adding the type annotations...
Camarade_Tux_ has quit ["Leaving"]
<aij>
mrvn: this wasn't a problem before I defined the pcfg type (as a record) rather than making t be the same (but not polymorphic) record
<mrvn>
keep adding. in my experience one ends up with some place with an error.
<aij>
mrvn: well, I don't understand why it thinks t isn't a subtype of (G'.t, Ast.stmt list BM.t, '_a) pcfg
Smerdyakov has quit ["Leaving"]
<aij>
mrvn: I mean, even if there is an error somewhere, the compiler shouldn't be lying :/
<hcarty>
aij: It isn't. Doesn't '_a mean that the type is undetermined (or whatever the proper CS-speak is)?
<mrvn>
aij: the '_a might not be V.t LM.t.
<mrvn>
it is unknown but not polymorphic.
<aij>
mrvn: yes, but that doesn't seem to be a problem for any of the smaller examples I made
<aij>
the 'a should just be getting bound to V.t LM.t
<mrvn>
With 'a I would see no problem but '_a is different
<aij>
mrvn: I tried it with a smaller example and it worked fine there
<hcarty>
aij: Was the type still '_a?
<aij>
yeah, well it was a type containing '_a
<aij>
I thought ocaml didn't need type annotations except for polymorphic methods. Is that wrong?
<palomer>
very
<palomer>
ocaml isn't principally typed
<hcarty>
aij: My guess is that some code in the rest of your module is breaking the simple example case
<aij>
palomer: not sure what you mean
<palomer>
aij, if you use polymorphic variants, a function can have many incompatibly types
<palomer>
s/incompatibly/incompatible
<palomer>
(there's a flag for making it principle again, though)
<aij>
palomer: ok, if I refine that to say, I thought ocaml didn't need type annotations except for polymorphic methods and language extensions. Is that wrong?
<hcarty>
That gives you a fully polymorphic version without the : T
<hcarty>
This question and workaround/fix is listed in the FAQ I linked to earlier
<aij>
hcarty: yes, I know, my point is that the '_a was't being a problem there
jamii has joined #ocaml
<hcarty>
aij: Then something else in the full example probably breaks it
<aij>
g2g, bbl
flux has quit [Remote closed the connection]
jeanbon has quit [Read error: 110 (Connection timed out)]
<Ariens_Hyperion>
has anyonw manage to install ocaml batteries through godi in leaopard
<Ariens_Hyperion>
somewhere in teh build process
<Ariens_Hyperion>
cp is called with the option -a
<Ariens_Hyperion>
which is not available in mac os
flux has joined #ocaml
<palomer>
test cases are your friend
<palomer>
I became a better programmer when I got into the habit of writing test cases
_zack has quit ["Leaving."]
slash_ has joined #ocaml
<hcarty>
Ariens_Hyperion: I have not tried, but it is probably worth submitting a bug report. I think most if not all of the Batteries devs are developing on some form of Linux
komar_ has quit [Read error: 60 (Operation timed out)]
palomer has quit ["Leaving"]
<Ariens_Hyperion>
hcarty: I'm going to install gnu utils
bombshelter13_ has quit [Client Quit]
sOpen has quit [Read error: 60 (Operation timed out)]
kaustuv has quit [Remote closed the connection]
sOpen has joined #ocaml
<Yoric[DT]>
Ariens_Hyperion: there's a known bug.
<Yoric[DT]>
With a workaround, in the bugtracker.
<Yoric[DT]>
The workaround is annoying, we'll have to update the installer.
<Ariens_Hyperion>
lhaha
<Ariens_Hyperion>
the fix is exactly what I am doing now
hkBst has quit [Remote closed the connection]
<Ariens_Hyperion>
thanks for the heads up Yoric[DT]
<Ariens_Hyperion>
done!
Jedai has quit [Read error: 113 (No route to host)]
Elrood has quit ["When two people dream the same dream, it ceases to be an illusion. KVIrc 3.4.2 Shiny http://www.kvirc.net"]
<jonafan>
i'm going to learn a haskell
<Ariens_Hyperion>
the dark side :|||
<jonafan>
that's right
<jonafan>
the dark side
<jonafan>
quicker, easier
<jonafan>
ocaml's cool, but it's just too practical
<mrvn>
way too much fun
<Ariens_Hyperion>
jonafan: once you become an haskell jedi
<Ariens_Hyperion>
Your ability to distinguish line noise from code becomes infinite
<Ariens_Hyperion>
or at least you will hope it does
<jonafan>
haha
<jonafan>
yes they do seem to enjoy their operators
* brendan
loves listening to ocaml devs complain about haskell syntax
sOpen has quit [Read error: 110 (Connection timed out)]
<Ariens_Hyperion>
jonafan: if you are learning haskell because of the operators you can just skip it and learn the real deal
<Ariens_Hyperion>
perl 6 hyper operators + edge case retarness
<jonafan>
hah
<mrvn>
perl 6 -- because 5 wasn't obfuscated enough