flux changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | 3.11.0 out now! Get yours from http://caml.inria.fr/ocaml/release.html
seafood has joined #ocaml
seafood has quit []
seafood has joined #ocaml
seafood has left #ocaml []
slash_ has quit ["Verlassend"]
seafood has joined #ocaml
Smerdyakov has quit ["Leaving"]
mfp has quit [Read error: 60 (Operation timed out)]
cads has joined #ocaml
hkBst has quit [Read error: 104 (Connection reset by peer)]
Ched has quit [Read error: 110 (Connection timed out)]
Ched has joined #ocaml
cads has quit [Read error: 113 (No route to host)]
sOpen has quit [Remote closed the connection]
tar_ has joined #ocaml
sgnb has quit [Remote closed the connection]
sgnb has joined #ocaml
tar_ has quit []
bohanlon has joined #ocaml
Camarade_Tux has quit [Read error: 110 (Connection timed out)]
Camarade_Tux has joined #ocaml
prime2 has joined #ocaml
prime2 has quit [Client Quit]
<eut> is it possible to match for (a, b) c?
<thelema> how is c connected?
<mrvn> Match (x,y) with (a,b), c)
<mrvn> +(
<eut> hmm
<eut> is there a way to match without putting c in the tuple?
<eut> is there an equivalent match for: let f (a, b) c = ...;;? something like let f = function ...;;?
<thelema> no, the function keyword only allows one argument, and let f (a,b) c = ... defines a function with two keywords
verte has joined #ocaml
<eut> is there another method that can be used to match more than one argument?
<mrvn> no
<mrvn> let f (a, b) c = ... also needs let f = function (a, b) -> function c ->
<eut> ah so i can just chain them together like that
<thelema> yes, functions that take multiple values are really just functions that return other functions...
<thelema> i.e. int -> int -> int == int -> (int -> int)
<eut> ok, that makes more sense
<eut> i had been told that functions only took one argument but read in some tutorial that they could take multiple ones
<mrvn> let f x y = or let f = fun x y -> is just syntactic suggar.
<mrvn> You can even do things like this: # let f = function x -> Printf.printf "x = %d\n" x; function y -> Printf.printf "y = %d\n" y; function z -> Printf.printf "z = %d, sum = %d\n" z (x+y+z);;
<mrvn> val f : int -> int -> int -> unit = <fun>
<mrvn> # let g = f 1;;
<mrvn> # let h = g 2;;
<mrvn> y = 2
<mrvn> x = 1
<mrvn> val g : int -> int -> unit = <fun>
<mrvn> val h : int -> unit = <fun>
<mrvn> # h 3;;
<mrvn> z = 3, sum = 6
<mrvn> - : unit = ()
<eut> what is the meaning of the ';' operator in your initial let statement?
<thelema> eut: it's a sequencing operator -- [x; y] means do x, throw away the result, then do y.
<thelema> (you'll get a compiler warning if x doesn't return unit)
<eut> ok that makes sense
<thelema> There's an implied (and return its value) at the end of that explanation
<eut> how can i match for a symbol list list?
<eut> [head]::tail?
<eut> erm, [head]::tail doesnt seem to work for me
<thelema> match h::t -> print_int h; foo t
* thelema unbutchers his syntax
<thelema> match lst with [] -> () | h::t -> print_int h; loop t
<eut> print_int?
<thelema> print_int prints an integer.
<thelema> ocaml is strongly typed, with no overloading. Thus print_int
<eut> what if lst = [[1;2;2];[3;3;3];[4;3;2]]?
<thelema> then you couldn't use print_int, as h would be a list itself.
<thelema> you could of course, write more code to handle h as a list.
<eut> match lst with [] -> ( | h::t -> print_int h | [h]::t -> print_int (List.nth h 0); loop t?
<thelema> no, the head of lst can't be both an int and a list
<eut> how can you match for both int and list in the same match clause?
<thelema> It could be a variant type like this: Int of int | IList of int list
<thelema> match h with Int i -> print_int i | IList [] -> () | IList (h2::_) -> print_int h2
<eut> hmm
<thelema> For me, the safety gained by this programming style more than compensates for the ability to just print anything and have it stringify.
<mrvn> It also speeds up the code a lot.
<mrvn> and saves ram
<eut> is there a way to do it without a variant type?
<thelema> have a list with mixed values in it? Yes, but variants are the simplest and usually best way.
<eut> function [] -> () | h::t -> print_int h | <something>::t print_int (List.nth h 0)?
<thelema> eut: nope. Once you have [| h::t -> print_int h], the list is definitely a list of integers.
<mrvn> thelema: actualy no you can never have a list with different values in it.
<eut> yeah i see
<eut> so my question makes no sense
<mrvn> eut: In ocaml both 0 and [] are stored as 0. How then would ocaml know if you have [1;2;0] or [1;2;[]]?
<eut> it wouldnt
<mrvn> (Although the reason 0 and [] are both stored as 0 is that that question can never happen)
<mrvn> s/are/can be/
<thelema> mrvn: well, there's a variety of embeddings of the universal type in ocaml, usually with types resembling unit -> unit, but to first approximation you're right
<thelema> mrvn: actually, they're both stored as 1. :)
<mrvn> thelema: which means you make the types the same.
<mrvn> thelema: ups. same difference.
<thelema> you kind-of have a list with different values in it. It just happens that they're stored as unit->unit closures.
<mrvn> thelema: no, you have a list of (unit -> unit) closures. All the same type. :)
<mrvn> You can (and have to) hide different types inside cosures of the same type. That is the trick.
tonasinanton has left #ocaml []
<mrvn> eut: What you can do is write functions that can handle lists of different types. like List.iter print_int [1;2;3] and List.iter print_float [1.1;2.2;3.3]
<thelema> we're arguing semantics - you're right that the type of all the elements in a list has to be the same. And I'm right that you can construct a list "with mixed values in it", through hiding the values from the type system.
<eut> i'm just essentially trying to do a depth first search of a tree in list form
<eut> or depth first traversal.. not search
<mrvn> for that you need to know the depth of the tree.
<mrvn> i.e. how many 'a list list ... list you have.
<eut> i was thinking its possible to keep expanding as long as the head is a list
<eut> or not an 'atom' (coming from lisp)
<mrvn> which can't be typed.
<mrvn> You can use type tree = Leaf of int list | Node of tree list
<mrvn> or type tree = Leaf of int ....
willb1 has quit [Read error: 110 (Connection timed out)]
<eut> type tree = Leaf of int | Branch of int list?
<eut> what if i wanted to make it of 'a list? would this work: type tree = Leaf of 'a | Branch of 'a list
<mrvn> let rec traverse = function Leaf x -> print_int x | Branch of list -> List.iter traverse list
<mrvn> eut: No, Branch of tree list
<eut> ah i see
<mrvn> You want to allow for Branch [Branch [Leaf 1; Leaf 2]; Leaf 3]
<mrvn> for 'a you need type 'a tree = Lead of 'a | Branch of 'a tree
<thelema> type 'a tree = Leaf of 'a | Branch of 'a tree list
<mrvn> list
<mrvn> yes
<eut> syntax error at 'of' in Branch of
<eut> in let rec traverse...
<thelema> no 'of' when doing matching
<mrvn> -of, sorry.
<eut> how do i create the tree to pass in?
<mrvn> Usualy you would have an empty tree and then you insert things.
<mrvn> let empty = Branch []
<mrvn> But you can give a tree verbatim like Branch [Branch [Leaf 1; Leaf 2]; Leaf 3]
<eut> ah
<eut> its starting to make more sense
<mrvn> Other people use a treetype like type 'a tree = Nil | Node of 'a tree * 'a * 'a tree.
<mrvn> That is more like lists where you have [] as end-of-list marker.
<eut> what about: type ('a, 'b) symbol = B of 'a | L of 'b?
<eut> where B is branch and L is leaf
<thelema> what type would the following have: B [ B [ L 1; L 2]; L 3] ?
<mrvn> no recursion in the type so you end up with a specific type for every tree.
<mrvn> # B [ B [ L 1; L 2]; L 3];;
<mrvn> - : ((('a, int) symbol list, int) symbol list, 'b) symbol =
<thelema> eut: not what you expected, I think.
<mrvn> type 'a tree = B of 'a tree list | L of 'a
<mrvn> # B [ B [ L 1; L 2]; L 3];;
<mrvn> - : int tree = B [B [L 1; L 2]; L 3]
<mrvn> See the difference?
<eut> ah yeah right
<mrvn> You can have ('a, 'b) tree or ('a, 'b, 'c, 'd, 'e, 'f, 'g) whatever. But here that just isn't neded.
<mrvn> if you can code that then I want one.
<mrvn> ups.
<eut> :]
seafood has quit []
Alpounet has joined #ocaml
jeddhaberstro has quit []
mishok13 has joined #ocaml
sOpen has joined #ocaml
<sOpen> is it possible to declare recursive function types? Like: 'a t -> 'a t -> 'a t... I am trying: let cap = (let rec ic = (fun lst -> function Some x -> ic (x :: lst) | None -> lst) in ic []);; and I don't understand the type error.
<sOpen> I've played around without the Option monad, too. I don't think using it is the right way because it means the function signature terminates which is wrong.
<sOpen> # let cap = (let rec ic = (fun lst x -> ic (x :: lst)) in ic []);; (* is the alternative that also doesn't work *)
<mrvn> sOpen: ic is a function taking 2 arguments. If the second is Some x you return a function, if the second is None you return a list
<sOpen> mrvn, yes. :-( How about: let cap = (let rec ic lst x = ic (x :: lst) in ic []);; ?
<sOpen> repl says "This expression has type 'a -> 'b but is here used with type 'b" but 'a -> 'b == 'b
<Alpounet> Hi everybody.
<mrvn> no, 'a -> 'b is not 'b
<sOpen> mrvn, why not?
<mrvn> Because one is 'a -> 'b and the other is 'b
<sOpen> ultimately i want 'a -> 'a -> 'a ...
<mrvn> % ocaml -rectypes
<mrvn> # let rec ic lst x = ic (x :: lst);;
<mrvn> val ic : 'a list -> ('a -> 'b as 'b) = <fun>
<mrvn> why is x a function?
<mrvn> never mind, x is the 'a
<sOpen> mrvn, yeah... that works like i want!
<sOpen> What is this rectypes arg? man page is silent
<mrvn> sOpen: You have to wrap that into a type to get around the type recursion.
<mrvn> sOpen: -rectypes lets ocaml look for implicit recursive types.
<sOpen> mrvn, what's the trade-off? why isn't rectypes always on?
<mrvn> because normaly one doesn't want to write code like that
<sOpen> fair enough. I'm glad it's possible, though. :-)
<mrvn> sOpen: What would you do with a type like that? You could never do anything sensible with it.
<sOpen> mrvn, i'm trying to figure that out... just exploring
pierre_m has joined #ocaml
<mrvn> With rectypes you can do a nice continuation style based cooperative multitasking in ~3 lines.
<sOpen> mrvn, :-)
<mrvn> defining an actual type thread = ... and doing it without rectypes adds a few lines but is so much more readable.
<sOpen> mrvn, yes... i certainly don't have a use that /cannot/ be done with normal types. I'm thinking about state machine DSLs.
acatout has quit ["leaving"]
acatout has joined #ocaml
verte has quit [Read error: 110 (Connection timed out)]
verte has joined #ocaml
s4tan has joined #ocaml
<Camarade_Tux> is it possible to call the array pretty-printer function from another one in the toplevel : I have a hash table which holds an array per-element and would like to display it gracefully
<Alpounet> why wouldn't it be possible ?
<Camarade_Tux> because I have beautiful eyes ? :)
<Camarade_Tux> or simply because it can be handy ;)
<Alpounet> If you have an array pretty printer function, I think there's no problem with calling it, as long as you've loaded your function's module.
<Camarade_Tux> no, I mean, not mine but ocaml's built-in
<Camarade_Tux> another solution would be to make a hashtbl pretty-printer so ocaml would automatically calls the array one
komar_ has joined #ocaml
<Camarade_Tux> except that ocaml does not want to use because Hashtbl.t is abstract =/ (well, I'll see that later on)
babalu has joined #ocaml
<babalu> hi, does someone know how to do a sleep in microseconds in ocaml ?
<babalu> or at least miliseconds
<babalu> milli*
<Camarade_Tux> last time I needed one, I wrote a C-binding (was about one line, two at most)
<Camarade_Tux> iirc the problem is there is no cross-platform way to do one
<Camarade_Tux> babalu, well, actually : see "Short sleeps" at http://pleac.sourceforge.net/pleac_ocaml/datesandtimes.html
<babalu> yeah it uses select
<Camarade_Tux> works if you're not on windows, and if you use lablgtk, it has a Glib.usleep
* Camarade_Tux doesn't understand why suddenly ocaml displays his hash table using the pretty-printer although he changed *nothing*
<Alpounet> Haha.
<Alpounet> nice :-)
<Alpounet> brb
Alpounet has quit ["Quitte"]
mfp has joined #ocaml
jeanbon has joined #ocaml
komar_ has quit [Remote closed the connection]
<babalu> thanks
<sOpen> I get a syntax error in http://paste.debian.net/33032/ on line 5, characters 30-32 ("as"). Perhaps I am misreading http://caml.inria.fr/pub/docs/manual-ocaml/types.html Why is the compiler unhappy?
Alpounet has joined #ocaml
<sOpen> and yes, this code is abusive
<mfp> sOpen: the 'b type variable is unbound
<mfp> you can solve that an get rid of the syntax error by turning the type into type ('a, 'b) action
<sOpen> mfp, http://caml.inria.fr/pub/docs/manual-ocaml/types.html#@manual.kwd4 doesn't bind 'b?
<sOpen> i'm running with -rectypes
<mfp> misread the code
<mfp> try | Load of (('a action -> 'b) as 'b)
<mfp> (works for me, then syntax error on l17: you have let rec iisf = ... without ... in xxx)
<sOpen> yep
<sOpen> that is actually a problem... I will throw parens at everything from now on
sgnb has quit [Remote closed the connection]
sgnb has joined #ocaml
<sOpen> mfp, thanks for your help
<mfp> np
Yoric[DT] has joined #ocaml
<Alpounet> Error: Files errors.cmo and lexer.cmo
<Alpounet> make inconsistent assumptions over interface Lexer
<Alpounet> o_O
<Alpounet> sounds weird.
<sOpen> Alpounet, compiled with different versions of lexer.mli?
Alpounet has quit [Read error: 104 (Connection reset by peer)]
Alpounet has joined #ocaml
pierre_m has quit ["Leaving."]
<sOpen> http://caml.inria.fr/pub/ml-archives/caml-list/2002/11/64c14acb90cb14bedb2cacb73338fb15.en.html seems a little short-sighted. Manycore machines may move away from shmem, though, I suppose.
komar_ has joined #ocaml
OChameau has joined #ocaml
<mrvn> "Of course, all this SMP support stuff slows down the runtime system
<mrvn> even if there is only one processor, which is the case for almost all
<mrvn> our users..." is just plain wrong nowadays
chahibi has joined #ocaml
jamii__ has joined #ocaml
<sOpen> yeah... multicore is everywhere. ocaml and python seem to be fighting the same demons
<flux> while it may be (and I think it is) true that shared memory approach won't scale beyond 8 cores, it'd be nice to have support for it while we're still in that space :)
alp_ has joined #ocaml
<flux> but I wonder how to architect software if you have, say, 64 cores, and for best performance you just can't just share everything. does it make sense to have multiple clusters of 8 cores with shared-everything while the clusters don't share between each other?
<flux> in the end, message passing might just turn out to be more feasible
<flux> too bad I haven't heard much of the project that was supposed to bring multicore-gc to ocaml
Alpounet has quit [Read error: 60 (Operation timed out)]
<sOpen> flux, i've programmed on the Tile64 and message passing between cores was 1-4 cycles depending on what bus you use
<flux> sopen, too bad such primitives don't seem to exist in the intel/amd world
<sOpen> it may not be the winning design but it scales a hell of a lot better than crossbars
<sOpen> flux, intel has an 80-core chip in r&d... i don't know how it handles shmem
<flux> well, Sun released (?) their 64-core offering
<flux> supposedly people run Java on those machines. I wonder how it works, then. Running a single jvm in 64 cores would basically be a shared-everything environment.
<flux> but perhaps they run multiple jvms then.
<sOpen> the sun chip is 8 cores with 8-way in-core threading
<flux> hm, right
<flux> mixed that up
<flux> well, it's the same issue still
babalu has quit ["Leaving"]
<sOpen> yeah... i wonder how the mm works
<sOpen> it looks like it's all shared from http://blogs.sun.com/deniss/entry/memory_and_coherency_on_the
oriba has joined #ocaml
olegfink has quit [Read error: 110 (Connection timed out)]
olegfink has joined #ocaml
olegfink is now known as Guest42722
alp_ is now known as Alpounet
Guest42722 is now known as olegfink
Ori_B_ has joined #ocaml
Ori_B has quit [Read error: 110 (Connection timed out)]
verte has quit [Read error: 110 (Connection timed out)]
verte has joined #ocaml
hkBst has joined #ocaml
TaXules has quit [calvino.freenode.net irc.freenode.net]
TaXules has joined #ocaml
<sOpen> "The current implementation accepts identifiers up to 16000000 characters in length."
chahibi has quit [Remote closed the connection]
Nucleos has joined #ocaml
<Nucleos> Hello.
<Nucleos> Here is my current problem : http://paste.tgl0be.org/?id=9469
<mrvn> Nucleos: no it doesn't.
<mrvn> Both the begin and the match are superflous by the way.
<Camarade_Tux> works for me too
<Nucleos> i didn't say the right thing
<Nucleos> it works, ok, but you didn't define est_interdit_triplet with that
<Nucleos> you defined est_interdit
<mrvn> val est_interdit : int * int -> bool = <fun>
<mrvn> val est_interdit_triplet : (int * int) * (int * int) * (int * int) -> bool =
<mrvn> <fun>
<mrvn> Looks right to me. Might not be what you want but that is what you wrote.
<Nucleos> ...
<Nucleos> i'm going to test another version of ocaml's implementation then. weird.
<mrvn> # est_interdit_triplet ((1,1), (2,1), (1,2));;
<mrvn> - : bool = true
<Camarade_Tux> Nucleos, how do you test ?
<Camarade_Tux> (which command(s) do you run)
<Nucleos> this is what i see : http://paste.tgl0be.org/index.php
<Nucleos> o sorry
<mrvn> because the "in" is wrong there
<mrvn> or the ";;"
<Nucleos> that's what i thought ; tell me more
<thelema> let est_interdit_triplet (a,b,c) = est_interdit a && est_interdit b && est_interdit c
<mrvn> with "in" the est_interdit_triplet is a subfunction of est_interdit so you would have to end with "in something;;"
<Nucleos> arf
<Nucleos> yes of course.
<mrvn> thelema: any idea how goo ocaml is at seeing that linterdits is a constant?
<Nucleos> Thanks for the help! I was really staring at the code... couldn't find anything
<mrvn> -l
<thelema> in ocaml, you can have a bunch of toplevel phrases: [let v = val;; let v2 = val2;; let v3 = val3;;] (with or without the ;;s)
<Nucleos> (thelema, you're right, my code if obfuscated.)
<Nucleos> :)
<thelema> or you can have one toplevel phrase: [let v = val in let v2 = val2 in let v3 = val3 in val4;;] (with or without the ;;s
<thelema> once you have 'in', you have to have a final expression for which your binding is defined 'in'.
<thelema> (i.e val4)
<thelema> the scope is no longer the rest of your source file.
<thelema> one could use the phrases 'local binding' vs. global binding, but that's not quite right
<thelema> mrvn: what would you want ocaml to do with linterdits as a constant? I don't see any easy way to propogate it.
* Nucleos has finally understood [ ] are no actual part of ocaml coding
<Nucleos> thelema, the thing is, when you use the "promptline" that you may want to define first a, then define a function f of a. With Ocaml, you must specify you are actually declaring a function, then you can declare a, then you can use it in the body of the function.
<Nucleos> only a question of syntax... doesn't matter.
<thelema> "promptline" = "toplevel"
<thelema> as to compiled vs. toplevel, the same code works - the rules are exactly the same.
<thelema> I guess there's an implied ;; at the end of code to be compiled
<Nucleos> thelema, I did think that way : i want to define foobar, then use it.
<Nucleos> I understood that you may define foobar globally then use it.
<thelema> but if you take any sequence of "commands" at the toplevel and put them into a file, you'll get the same result (except for the toplevel's nice printing of return values)
<Nucleos> I understood also you may define it locally.
<thelema> both work, yes.
<Nucleos> I wanted to "press Enter" (= evaluate) and have my function.
<Nucleos> In the toplevel, you have to press Enter twice if you use the first method.
<Nucleos> I know it makes quite no sense to talk about that.
<thelema> huh? enter twice?
<Nucleos> never mind.
<thelema> the toplevel knows to start evaluating by ";;"
<thelema> you can give it as much code as you want, and it'll evaluate it all once it sees ;;
<Nucleos> see that : [let test var = let b = 5 in var = 5;;] You may want to do that : [let b = 5;; let test var = var = 5;;]
<Nucleos> In the toplevel you can't write it at once, then press Enter.
<Nucleos> Syntax error : in the toplevel you can't "chain" 2 <;;>
<thelema> # let b = 5;; let test var = var = 5;;
<thelema> val b : int = 5
<thelema> on my computer, it seems to have skipped everything after the first ;;
<Nucleos> right.
<Camarade_Tux> btw, has mlbot appeared on the channel yet ?
<Nucleos> thelema, thus you have to either first know what you're doing, either "press twice the button"
jeanb-- has joined #ocaml
jeanbon has quit [Nick collision from services.]
jeanb-- is now known as jeanbon
jamii__ has quit [Read error: 60 (Operation timed out)]
<mrvn> thelema: create the data for interdits once and don't call a bunch of cons at runtime.
rogo has quit ["Leaving."]
verte has quit [":("]
s4tan has quit [Client Quit]
Ariens_Hyperion has joined #ocaml
ttamttam has joined #ocaml
ttamttam has left #ocaml []
_zack has joined #ocaml
BiDOrD has quit [Read error: 60 (Operation timed out)]
oriba has left #ocaml []
BiDOrD has joined #ocaml
mishok13 has quit [Success]
jeddhaberstro has joined #ocaml
rjones has joined #ocaml
rjones has left #ocaml []
rwmjones has quit [Remote closed the connection]
komar_ has quit [Read error: 113 (No route to host)]
Komar_ has joined #ocaml
hsuh has joined #ocaml
dejj has joined #ocaml
Amorphous has quit [Read error: 110 (Connection timed out)]
Amorphous has joined #ocaml
jeddhaberstro has quit []
ttamttam has joined #ocaml
ttamttam has left #ocaml []
OChameau has quit ["Leaving"]
<Alpounet> http://ocaml.pastebin.com/d649f0fd <<< anyone has an idea about why I get the error ? :/
Komar_ has quit [Remote closed the connection]
<Yoric[DT]> Alpounet: you need begin/end or parenthesis around your imperative block.
<Yoric[DT]> The grammar is [if expression_1 then expression_2 else expression_3]
<Alpounet> (I'll put something in else, that's just for having something)
<Alpounet> okay, thanks. !
<Yoric[DT]> here, the ; in the middle of your expression_2 confuses the parser.
<Yoric[DT]> np
<Alpounet> I should get used to imperative programming a little more... heh :-)
vuln has joined #ocaml
<Ariens_Hyperion> you meant functional
<Alpounet> No, I meant imperative programming in OCaml.
<vuln> May anyone introduce me to an example of parametric polimorfism in Ocaml?
<Alpounet> type 'a mylist = Nil | Cons of 'a * 'a mylist ;;
<vuln> hum
<vuln> That's my problem
<vuln> ok.
<vuln> I just misunderstood some stuff haha
<vuln> thanks :)
<Alpounet> 'a is an arbitrary name chosen to give a name to a type paramer.
<Alpounet> It's a kind of "type variable"
<Alpounet> you can then reuse it at the right of "="
<Alpounet> brb
Alpounet has left #ocaml []
mishok13 has joined #ocaml
kaustuv_ has joined #ocaml
prime2 has joined #ocaml
mishok13 has quit [Connection timed out]
mishok13 has joined #ocaml
<flux> interesting news, on caml-list. apparently the parallel gc I just today, yesterday? mentioned, is going well!
<mbishop> link?
komar_ has joined #ocaml
sOpen has quit [Read error: 110 (Connection timed out)]
mishok13 has quit [Read error: 145 (Connection timed out)]
sOpen has joined #ocaml
bluestorm has joined #ocaml
oriba has joined #ocaml
oriba has left #ocaml []
mishok13 has joined #ocaml
vuln has quit ["leaving"]
_zack has quit ["Leaving."]
ygrek has joined #ocaml
slash_ has joined #ocaml
jamii has joined #ocaml
sOpen has quit [Read error: 110 (Connection timed out)]
sOpen has joined #ocaml
jeanb-- has joined #ocaml
jeanbon has quit [Nick collision from services.]
jeanb-- is now known as jeanbon
Alpounet has joined #ocaml
hsuh has quit [Remote closed the connection]
hsuh has joined #ocaml
hsuh` has joined #ocaml
hsuh` has quit [Remote closed the connection]
hsuh has quit [Remote closed the connection]
hsuh has joined #ocaml
slash_ has quit [Client Quit]
BiDOrD has quit [Read error: 110 (Connection timed out)]
BiDOrD has joined #ocaml
komar_ has quit [Read error: 104 (Connection reset by peer)]
slash_ has joined #ocaml
Nucleos has quit [Read error: 60 (Operation timed out)]
komar_ has joined #ocaml
jamii has quit [Read error: 113 (No route to host)]
Nucleos has joined #ocaml
jedai has quit [Read error: 60 (Operation timed out)]
thelema has quit [Read error: 110 (Connection timed out)]
itewsh has joined #ocaml
Associat0r has joined #ocaml
<aij> wow, a Stack_overflow that is actually indicative of a real error
komar_ has quit [Remote closed the connection]
<Alpounet> heh
komar_ has joined #ocaml
<aij> I'm sometimes tempted to write my own Hashtbl and make it tail recursive
<aij> but in this particular case, the Stack_overflow caused by Hashtbl.resize was indicative of a problem...
ygrek has quit [Remote closed the connection]
<flux> I suppose it happens when there are too many values with the same key?
Associat0r has quit [Client Quit]
sOpen has quit [Read error: 110 (Connection timed out)]
<Nucleos> How can I do something like this ? [type trou = Neant | { gauche: trou; droite: trou; }]
vuln has joined #ocaml
<vuln> Alpounet: hey
<vuln> I'm sorry, last time when I noticed, you have already gone so I couldn't thank you :)
jeanb-- has joined #ocaml
<flux> nucleos, type trou = Neant | Gauche of gauche and gauche = { gauche : trou; droite : trou }
jeanbon has quit [Nick collision from services.]
jeanb-- is now known as jeanbon
m3ga has joined #ocaml
<Alpounet> vuln, you're welcome. I don't remember your problem, though. (I've got too many in here to remember others')
<vuln> Alpounet: parametric polimorfism
<vuln> :)
<Alpounet> Oh, yep :-)
<Nucleos> flux, syntax error :(
<Alpounet> (polymorPHism)
<vuln> thanks :)
<vuln> and I have a new question about it haha
<flux> nucleos, nope, I copy pasted that to my ocaml and it works fine
<vuln> I would like to create a function to sum a number. It might be float OR int
<aij> == flux
<vuln> I tried just type them, and hope that through its arguments both will work, but the last overwrite the first
<vuln> :)
<vuln> and so I figured out I might do it with classes, but I couldn't find an article or book that tells exactly what I want.
<vuln> :(
<Alpounet> You want to sum ... a number ?
<vuln> Alpounet: I want to make a function that sum two numbers, but they might be FLOAT or INT
<vuln> I will try to write it here in codepad.. one sec.
<Alpounet> ocaml.pastebin.com
<aij> vuln: what type do you expect your function to have?
<Nucleos> flux, well it works here too. Thanks a lot!
<vuln> something like this Alpounet
<Nucleos> flux, how can i know when i'm allowed to use "and"?
<bluestorm> Nucleos: type trou = Trou of (trou * trou) option
<vuln> aij: it can't be 'a, 'cause there's no overload of operators in Ocaml
<vuln> :(
<flux> nucleos, well, you could read the language specification from the manual
<Alpounet> vuln, neither for functions
<aij> vuln: you just tried to write an overloaded function
<Nucleos> flux, i see.
<vuln> aij: yes
<vuln> That's my goal :P
<vuln> Can't I ?
<bluestorm> you can't
<aij> no, there's no overloading in ocaml
<Nucleos> flux, anyway i'm glad. :)
<vuln> :(
<aij> operators are just functions that happen to be inline
<Alpounet> infix ?
<flux> nucleos, in addition to bluestorm's suggestion you could do: type 'a gauche = { gauchy : 'a; droite : 'a } type trou = Neant | Gauche of trou gauche
<aij> Alpounet: ack, yes
<vuln> I thought parametric polimorphism extended including to allow a function behaves differently given different args
<flux> but and is a better match here
<vuln> aij: Alpounet
<flux> or actually, bluestorm's suggestion ;)
<Alpounet> vuln, are you coming from Haskell ?
<vuln> Alpounet: no.
<vuln> coming from C
<bluestorm> flux: or -rectypes :-'
<vuln> :)
<Alpounet> ok
<vuln> I've never studied other functional programming language
<bluestorm> flux: Gauche of trou gauche is a bad naming
<vuln> I'm studying Ocaml at university.
<flux> bluestorm, quite possibly, I have no idea what they mean
<bluestorm> (but if you don't know french you couldn't get that)
<vuln> The teacher talked about parametric and ad-hoc polimorfism and I just got curious.
<bluestorm> gauche => left, droite => right
<Nucleos> bluestorm, i don't know "option". Trying to figure it out. Thanks !
<aij> vuln: you could do the equivalent of what's in the last link you pasted
<bluestorm> Nucleos: type 'a option = None | Some of 'a
<bluestorm> (predefined by caml standard lib)
<vuln> aij: That's what I want :)
<vuln> Using classes, right?
<Nucleos> bluestorm, even better !
<Nucleos> flux, i don't understand your code, but i'll thing about it. I need some time to comprehend type definition. I thought I knew... :)
<aij> vuln: you could do it as classes or as functions
<bluestorm> it's a mutually recursive type definition
komar_ has quit [Read error: 104 (Connection reset by peer)]
<vuln> aij: as functions, it wouldn't be using 'a, right?
jamii has joined #ocaml
<vuln> aij: May you tell me the two ways, please?
<Nucleos> bluestorm, ok.
<aij> vuln: eg, let soma = (+.) and subtracao = (-.)
<vuln> aij: but I want equal names :D
<bluestorm> vuln: you don't always get what you want
<vuln> bluestorm: hahah
<vuln> true
<aij> vuln: the thing you pasted used different names
<bluestorm> why would you want that anyway ? integer addition and float addition are very different beasts
<flux> vuln, well, there's no way to make it so that add 4 5 and add 4.0 5.0 will work
<bluestorm> float operation incur precision concerns, etc.
<vuln> Ok, so let's go straightly to my question.
<vuln> May you define how far 'parametric polimorphism' goes in Ocaml?
<flux> vuln, what could work would be: add (int 4) (int 5) and add (float 4) (float 5), given proper definitions
<aij> vuln: you could also define classes with methods of the same name doing different things
<vuln> aij: THIS!
<vuln> How?
<vuln> :D
<bluestorm> vuln: there is no ad-hoc polymorphism, except for late-binding in object-oriented OCaml
<aij> vuln: but the class names would be different, just as the function names would be different if you do it with functons
<vuln> bluestorm: late-binding?
<Nucleos> vuln, to me, it looks like a perfect case for [ type nombre = Float of float | Int of int ]
<bluestorm> vuln: if you're learning OCaml, you shouldn't try OOP first
<bluestorm> that's the lazy and bad way, "i'll try to reproduce my Java knowledge in this new language"
<bluestorm> you should try OCaml the ocaml way
<aij> vuln: class soma = object method calcular = (+.) end class subtracao = object method calcular = (-.) end
<bluestorm> no ad-hoc polymorphism, no overloading, and as little OOP as possible
<vuln> bluestorm: Ok
<vuln> I will follow your suggestions so :)
<aij> vuln: but, ocaml isn't java, so there's no need to wrap your functions inside a class
<vuln> Alpounet, aij, bluestorm, flux thank all of you
<vuln> :)
<vuln> aij: I don't know Java
<vuln> I just pasted the code I saw on Wikipedia about Polimorphism :)
<aij> vuln: ah, you're looking at the wrong wikipedia article then. See http://en.wikipedia.org/wiki/Type_polymorphism instead
<vuln> aij: thanks :)
itewsh has quit [Success]
<vuln> At first, Ocaml looked awkward to me. No reason to learn it
<vuln> But my point of view has changed a lot lately.
itewsh has joined #ocaml
<flux> vuln, what affected it the most?
<vuln> flux: I'm sorry?
<vuln> What made me think like that?
<flux> you changed your point of view changed a lot lately. what made it change?
<vuln> flux: Ocaml Learning :)
<vuln> It's too easy talk bad about something when you don't know it
<vuln> My major is Computer Engineering. However, I go some classes in other departaments like Computer Sciense. And CC departament is who wanna teach us Ocaml
<vuln> So everybody says: It's a language to go ahead at the univ, but you will throw it away after 6 months
<vuln> All students say the same, that it's horrible and stupid and stuff like that
<vuln> Maybe 'cause some teachers say the same, OR 'cause they're too dumb to recognize a good programming language
<olegfink> I wish they'd teach us ocaml here.
<Alpounet> +1.
<olegfink> you know, java isn't exactly my definition of 'fun'
<vuln> olegfink: 70% of the classes EVERY period get reproved.
<vuln> I have veterans of veterans of mine studying in my class haha
hkBst has quit [Read error: 104 (Connection reset by peer)]
<vuln> But, IMHO, is not the case about Ocaml be good or not. I think it's perfect in the course 'cause: It has several new implementations (modern ones) and a lot of concepts and techniques to program
* Nucleos never understood why people are so contemptful with bad students.
<Alpounet> doesn't Unix.close_process "kill" the process ?
<vuln> The name of the matter is: Concepts and Tecnics of Programming
<vuln> So, Ocaml is the most perfect programming language for it
<Ariens_Hyperion> contemptful??
<vuln> And it's too easy as first language (at least its base)
<vuln> I always studied imperative languages, so it was hard at first time to me. It was my first reason to 'hate' Ocaml
<vuln> But today, I have a new part of my brain thinking how I can solve problems differently
<vuln> and sometimes even better than I could before know Ocaml.
<vuln> I think I'm the only person in my class that say: I like Ocaml.
<vuln> Just to you know how 'strong' the influence of the olders are :)
<vuln> But I have to say I'm ansious for C in the next period haha
<olegfink> after my first year or so studying ocaml in high school, my friends would give me strange looks looking at my C code full of recursive functions and stuff.
<vuln> God, I talk too much ;x
<vuln> olegfink: I couldn't solve my first exercise list without change states or iterations haha
<Ariens_Hyperion> that has to change!!
<vuln> The teacher was writing a question to list numbers and before he finish it, I was already writing some code with while
<vuln> haha
<vuln> Ariens_Hyperion: It already changed :)
<vuln> thanks Lord
<vuln> hehe
<vuln> But the 'course' is really hard. I mean, I didn't get as well as I wanted in the exam..
<vuln> I can imagine how people who have never studied language programming were..
<vuln> I wanted 10 of course :P
<vuln> haha
* Nucleos 's just learned the word 'contemptful' doesn't exist in a dictionary. One says 'to hold sb in contempt'. / to be scornful
<vuln> But things are getting better now. Recursivity, Pattern-Matching and all the good stuff are starting now :D
<olegfink> I have a small students project: get used to apl/j/k/q and then try going back to java classes. bwahaha!
<vuln> hahaha
<vuln> I want to do something AWESOME in Ocaml before finishs the matter.
<vuln> In each specific matter. I'm going to project a bomb in Digital Circuitos
<vuln> MUAHAHAHA
<vuln> XD
<vuln> Circuits*
<hsuh> vuln: q estado?
<Ariens_Hyperion> I wish I could use ocaml with cocoa to do something awesome
<Alpounet> Damned. How can I kill a process ?
<vuln> hsuh: RN
<vuln> Alpounet: in Ocaml?
<Alpounet> yeah
<Alpounet> Unix.close_process waits for the process to terminate
<bluestorm> Alpounet: Unix.signal ?
<olegfink> Alpounet: Unix.system ("kill "^(string_of_int pid))? :-)
<flux> alpounet, a process you usually run with open_process should usually get rid of itself when stdin closes
<olegfink> yeah, Unix.signal pid 11 or something.
<flux> while Unix.kill works, it can be difficult to find the process id..
<Alpounet> I created it with open_process
<Alpounet> I just have the associated channels
<Alpounet> no PID
<olegfink> wait, there's kill. oops.
<vuln> hsuh: e você?
<hsuh> vuln: RS
<vuln> hsuh: extremos hehe
<hsuh> vuln: hehe
<vuln> Vai para o FISL?
<hsuh> vuln: n... fui soh uma vez qdo foi na puc-rs
<vuln> :)
thelema has joined #ocaml
<flux> alpounet, in that kind of cases I would just drop the use of open_process and do it by hand
<flux> which means using pipe and fork
<Alpounet> oh wait
<flux> (possibly multiple pipes)
Smerdyakov has joined #ocaml
<flux> it works nicely with select also
<Alpounet> create_process returns the pid
<flux> oh, it does, indeed
<Alpounet> then I can call Unix.kill pid [the correct signal]
<flux> well that should be enough then :)
<Alpounet> and it should be okay
<flux> Sys.sigterm or Sys.sigkill if you feel violent
<Alpounet> sigkill
<Alpounet> hahahahah
Ched has quit [Remote closed the connection]
<Alpounet> figood night
<Alpounet> -fi
Alpounet has quit ["Quitte"]
Ched has joined #ocaml
<kaustuv_> I finally figured out how to prevent the GC from moving stuff around, so here's the ocaml->svg renderer packaged up. Comments welcome. http://www.msr-inria.inria.fr/~kaustuv/misc/ocaml_show.html
<Nucleos> I have a last problem for today : http://pastebin.com/m18efbffe
<vuln> kaustuv_: GC?
<Nucleos> vuln, Garbage Collector.
<vuln> oh
<vuln> thanks :D
Ariens_Hyperion has quit []
<vuln> What does 'type t = E | N of t * int * t ;;
<vuln> ' it do?
<bluestorm> Nucleos:
<bluestorm> type NewSetInt = struct include SetInt ... end
<bluestorm> s/type/module/, sorry
<Nucleos> (trying...)
<Smerdyakov> vuln, what source are you using to learn OCaml? That seems like a pretty basic example.
<Nucleos> bluestorm, thank you.
<vuln> Smerdyakov: I have a lot of books I got in internet. But I've been following the files university gives me
<vuln> and we just finished records
<vuln> :)
<Smerdyakov> vuln, I suggest ignoring all course materials, when it comes to learning a programming language.
<vuln> We started pattern-matching last week
<Smerdyakov> vuln, just reading the tutorial in the OCaml manual should be sufficient.
<Smerdyakov> vuln, and it's not very long.
<vuln> Smerdyakov: Well, May you let me know what it does?
<Smerdyakov> vuln, no.
<Smerdyakov> vuln, it has no counterpart in mainstream languages, and so no one-liner explanation.
<m3ga> Smerdyakov, viln : it is a little like a C union
<Smerdyakov> m3ga, I think you're doing more harm than good. You can't possibly explain it better than the best tutorials and books.
<m3ga> true
<vuln> m3ga: thanks
<vuln> :)
<olegfink> honestly I've never seen that data structure implemented as a C union.
<Smerdyakov> vuln, I believe you can't go wrong with this book: http://files.metaprl.org/doc/ocaml-book.pdf
<vuln> Smerdyakov: I have it
<vuln> I read the first 70 pages
<Smerdyakov> vuln, good. Pick a book, and don't let yourself use _any_ feature you haven't read about it.
<Smerdyakov> s/about it/about yet
bluestorm has quit [Remote closed the connection]
<vuln> Smerdyakov: Well, thanks :)
<vuln> I'm glad you're thinking beyond just help me now
<vuln> but I also thank you m3ga hehe
<olegfink> m3ga, if you insist on unions, you should probably add that they have a 'type tag' associated.
<m3ga> to be honest i have never read more than about 5 contiguous pages of any ocaml book :-)
<kaustuv_> I've never read even a single page of any OCaml book.
<Smerdyakov> Some people get it easily. Some don't.
<m3ga> olegfink: i don't mention the type tag but do mention that the compiler won't let you get it wrong.
<Smerdyakov> But everyone should read instead of asking what a language feature is.
oof has joined #ocaml
<oof> hello
<m3ga> sometimes its useful to ask what it is. for vuln, the answer should have been "go to you book and read about variant types'.
<olegfink> I've found out that calling them 'algebraic' instead of 'variant' greatly helps understanding.
<Nucleos> Smerdyakov, i agree with m3ga : there's no question you should not ask.
<Smerdyakov> m3ga, I disagree. Authors of books put lots of effort into choosing the right order in which to introduce material. Asking what a language feature is shows that you aren't following an expert's chosen order, and your order is probably inferior pedagogically.
<m3ga> 'alegbraic' always confused me while 'variant' was immediately obvious
<vuln> =[
<vuln> :)
<kaustuv_> The problem is there are at least two distinguishable interpretation for "variant", and even the manual is not 100% on either side.
<olegfink> might be; at least it might help that some of the type operators have a familiar algebraic nature, such as '|' and '*'
<Smerdyakov> olegfink, those operators don't have the meanings you have in mind, for a large fraction of the people who want to learn OCaml.
<Smerdyakov> Anyone who learns best by analogies to higher math isn't going to have any trouble learning OCaml, and thus it's pointless to think about how to help them learn.
jeanbon has quit [Connection timed out]
<Nucleos> Smerdyakov, my math teacher doesn't agree with you. Anyway, you seem to live in a perfect world where everyone follows the rule, where everyone sticks to the advance of a book, etc. Happily, people tend to be less attracted to rigidity. I know it has some backwards, but that's the way it is.
<Smerdyakov> Nucleos, it's not so happy that people impede their own learning.
<Smerdyakov> Nucleos, people can do whatever they want. People who don't like to read rarely end up using ML.
<olegfink> well, I see your point.
<vuln> Smerdyakov: Can you give me a line which will return a' -> b' -> c' ?
<Smerdyakov> vuln, are you asking me to do your homework?
<vuln> Smerdyakov: no
<vuln> I don't think would be a question like that
<Smerdyakov> vuln, here is a definition of a function with that type: let rec f x y = f x y
<vuln> thanks Smerdyakov
<vuln> I'm just reading ocaml book and I remebered about an example like this that the professor show in class
Symmetry- has joined #ocaml
<Symmetry-> hello
jedai has joined #ocaml
<vuln> hello :)
Ched has quit ["Ex-Chat"]
mjambon has joined #ocaml
<hsuh> another day this guy asked why aren't all functions implicitly "let rec"s ... what would be the answer to that?
<Nucleos> i think the valid one: yes we could do that, but it has drawbacks, so we thought it was best that way.
prime2 has quit ["leaving"]
Nucleos has quit ["Quitte"]
itewsh has quit ["There are only 10 kinds of people: those who understand binary and those who don't"]
Yoric[DT] has quit ["Ex-Chat"]
kaustuv_ has quit ["e9769a5a3a9575c93219232b4da34123"]
jamii has quit [Read error: 113 (No route to host)]
deech has joined #ocaml
hsuh has quit [Read error: 110 (Connection timed out)]
m3ga has quit ["disappearing into the sunset"]
seafood has joined #ocaml
Smerdyakov has quit ["Leaving"]