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
Alpounet has quit ["Quitte"]
Associat0r has quit []
Yoric[DT] has quit ["Ex-Chat"]
<palomer> yeah, I was planning on doing it anyways
jonafan_ has joined #ocaml
bjorkintosh has quit [Read error: 110 (Connection timed out)]
Amorphous has quit [Read error: 110 (Connection timed out)]
<palomer> whew, just fixed a nasty off by one error
Amorphous has joined #ocaml
jonafan has quit [Read error: 110 (Connection timed out)]
jonafan_ has quit [Read error: 110 (Connection timed out)]
jonafan has joined #ocaml
jeddhaberstro has joined #ocaml
jeanbon has quit ["EOF"]
Camarade_Tux has joined #ocaml
mrvn has quit [Read error: 60 (Operation timed out)]
Ched has quit [Read error: 101 (Network is unreachable)]
Ched has joined #ocaml
Camarade_Tux has quit ["Leaving"]
SirNick has quit []
seafood has joined #ocaml
<palomer> off by 1 errors are the nastiest kinds of errors
jeddhaberstro has quit []
SirNick has joined #ocaml
seafood has quit [Read error: 104 (Connection reset by peer)]
seafood has joined #ocaml
mrvn has joined #ocaml
seafood_ has joined #ocaml
sOpen has joined #ocaml
<sOpen> I'm trying to get some sort of datetime string in OCaml. What's the simplest way? Unix.time doesn't seem to work.
seafood has quit [Read error: 110 (Connection timed out)]
<thelema> Unix.time |> Unix.localtime |> (fun t -> Printf.sprintf "%d-%d-%d %d:%d:%d" t.tm_year t.tm_mon t.tm_day t.tm_hour t.tm_min t.tm_sec)
<thelema> let (|>) x f = f x
eut has left #ocaml []
<sOpen> thelema, I get "Reference to undefined global `Unix'" when I do anything with Unix? It's like it's a data constructor?
<sOpen> thelema, sorry, I got it :-( stupid is...
<sOpen> thanks for the help!
<thelema> n/p
Associat0r has joined #ocaml
seafood has joined #ocaml
Associat0r has quit []
Ched has quit [Read error: 110 (Connection timed out)]
Ched has joined #ocaml
sOpen has quit ["Leaving"]
seafood_ has quit [Read error: 110 (Connection timed out)]
seafood has quit [Read error: 104 (Connection reset by peer)]
seafood has joined #ocaml
angerman has joined #ocaml
jeremiah has quit [Read error: 110 (Connection timed out)]
Alpounet has joined #ocaml
mlbot has joined #ocaml
komar_ has joined #ocaml
SirNick has quit []
rwmjones has joined #ocaml
_zack has joined #ocaml
s4tan has joined #ocaml
sgnb``` has quit [Read error: 104 (Connection reset by peer)]
sgnb``` has joined #ocaml
hkBst has joined #ocaml
angerman has quit []
|Jedai| has joined #ocaml
jamii_ has joined #ocaml
Jedai has quit [Read error: 110 (Connection timed out)]
Guest39247 is now known as fremo
noj has joined #ocaml
Ched has quit [Read error: 60 (Operation timed out)]
komar_ has quit [Remote closed the connection]
s4tan has quit [Read error: 110 (Connection timed out)]
jeanbon has joined #ocaml
slash_ has quit [Client Quit]
Associat0r has joined #ocaml
Camarade_Tux has joined #ocaml
Camarade_Tux_ has joined #ocaml
Camarade_Tux_ has quit [Client Quit]
s4tan has joined #ocaml
Camarade_Tux has quit ["Leaving"]
Camarade_Tux has joined #ocaml
hkBst has quit [Read error: 104 (Connection reset by peer)]
danbeimborn has joined #ocaml
<danbeimborn> Hello, wonder if there is a built-in like range in python or seq in shell to generate a list of nums from x to y? Can't find one
<mrvn> nope.
<totom> let rec range x y = if x>y then [] else x::(range (x+1) y)
<danbeimborn> pretty easy to make my own, but I thought it'd exist
<flux> danbeimborn, there are certain projects that attempt to address such shortcomings
<danbeimborn> totom: mine's almost the same :-). I'm a complete newbie to ocaml
<flux> danbeimborn, one of the more widely known ones are extlib and batteries; batteries contains all of extlib and then some
<flux> danbeimborn, btw, if that indeed is so, you can do better by making the function tail recursive
<danbeimborn> let rec range (a:int) (b:int) = if a > b then [] else a :: range (a+1) b ;;
<flux> although I suppose usually ranges are small: better provide a folding etc operations for ranges (or like ExtLib and Batteries have: enums)
<Alpounet> and for your use :
<danbeimborn> thatnks, that's interesting
<danbeimborn> any good links to documentation that gets into dealing with trees?
<flux> I haven't seen any library for that, perhaps because dealing with trees is what ocaml is quite good with its plain language
<flux> there is a graph library, though
<danbeimborn> well minus a library, I'm working on a puzzle from euclid that looks like a tree traversal question
<danbeimborn> just having trouble finding documentation. Not a computer scientist, but a decent shell/perl/python scripter instead
<danbeimborn> hehe
Ched has joined #ocaml
<mrvn> danbeimborn: No need to specify int
<mrvn> danbeimborn: a+1 makes a int and a > b then makes b int also. ocaml is really good in figuring out the right types.
<danbeimborn> ah I see
<danbeimborn> I was trying to protect myself from myself, this is part of my first script
<Alpounet> danbeimborn, you can find ready-to-use Tree modules on the web I think...
<mrvn> > let range a b = let rec loop acc x = if x < a then acc else loop (x::acc) (x-1) in loop [] b;;
<mlbot> val range : int -> int -> int list = <fun>
<mrvn> > range 2 5;;
<mlbot> - : int list = [2; 3; 4; 5]
<Alpounet> First look if they provide fold, map, iter, ... functions
<flux> nevertheles, it can sometimes be helpful to give types
<flux> it will tell you if you are trying to do something inconsistent
<Alpounet> Then, test their performances.
<flux> which was perhaps danbeimborn's idea
<flux> actually, it will tell that anyway, but it might tell it earlier or in a more proper place :0
<flux> s/0/)/
<mrvn> yeah, I often add types when I feel like the error is reported at the wrong place.
<Alpounet> > range 1 10000 ;;
<mlbot> - : int list =
<mlbot> [1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15; 16; 17; 18; 19; 20; 21;
<mlbot> 22; 23; 24; 25; 26; 27; 28; 29; 30; 31; 32; 33; 34; 35; 36; 37; 38; 39; 40;
<mlbot> 41; 42; 43; 44; 45; 46; 47; 48; 49; 50; 51; 52; 53; 54; 55; 56; 57; 58; 59;
<mlbot> 60; 61; 62; 63; 64; 65; 66; 67; 68; 69; 70; 71; 72; 73; 74; 75; 76; 77; 78;
<mlbot> ... (15 more lines)
<mrvn> Alpounet: yes, it is tail recursive
<Alpounet> ;-)
ttamttam1 has joined #ocaml
ttamttam1 has left #ocaml []
<Alpounet> > range 1 1000000 ;;
<mlbot> - : int list =
<mlbot> [1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15; 16; 17; 18; 19; 20; 21;
<mlbot> 22; 23; 24; 25; 26; 27; 28; 29; 30; 31; 32; 33; 34; 35; 36; 37; 38; 39; 40;
<mlbot> 41; 42; 43; 44; 45; 46; 47; 48; 49; 50; 51; 52; 53; 54; 55; 56; 57; 58; 59;
<mlbot> 60; 61; 62; 63; 64; 65; 66; 67; 68; 69; 70; 71; 72; 73; 74; 75; 76; 77; 78;
<mlbot> ... (15 more lines)
<Alpounet> > range 1 100000000 ;;
<mlbot> Thread killed
<Alpounet> heh
<mrvn> because it takes longer than 1s
<Alpounet> yeah
<mrvn> and 1.6GB ram
<Alpounet> I was looking for that.
<mrvn> or actually 2-4GB
<mrvn> 2.4
danbeimborn has quit [hubbard.freenode.net irc.freenode.net]
deech has quit [hubbard.freenode.net irc.freenode.net]
sgwizdak has quit [hubbard.freenode.net irc.freenode.net]
Asmadeus has quit [hubbard.freenode.net irc.freenode.net]
mal`` has quit [hubbard.freenode.net irc.freenode.net]
|Jedai| has quit [hubbard.freenode.net irc.freenode.net]
brendan has quit [hubbard.freenode.net irc.freenode.net]
seafood has quit [hubbard.freenode.net irc.freenode.net]
bohanlon has quit [hubbard.freenode.net irc.freenode.net]
mbishop has quit [hubbard.freenode.net irc.freenode.net]
<Alpounet> > (|>) ;;
<mlbot> Type Error
<Alpounet> > let (|>) x f = f x ;;
<mlbot> val ( |> ) : 'a -> ('a -> 'b) -> 'b = <fun>
<Alpounet> > range 1 100 |> filter (fun x -> x/2 = (x+1)/2) ;;
<mlbot> Type Error
<Alpounet> > range 1 100 |> List.filter (fun x -> x/2 = (x+1)/2) ;;
<mlbot> Type Error
<Alpounet> > (range 1 100) |> (List.filter (fun x -> x/2 = (x+1)/2)) ;;
<mlbot> Type Error
danbeimborn has joined #ocaml
|Jedai| has joined #ocaml
seafood has joined #ocaml
bohanlon has joined #ocaml
deech has joined #ocaml
mbishop has joined #ocaml
brendan has joined #ocaml
sgwizdak has joined #ocaml
Asmadeus has joined #ocaml
mal`` has joined #ocaml
<Alpounet> > let range a b = let rec loop acc x = if x < a then acc else loop (x::acc) (x-1) in loop [] b;;
<mlbot> val range : int -> int -> int list = <fun>
<Alpounet> > (range 1 100) |> (List.filter (fun x -> x/2 = (x+1)/2)) ;;
<mlbot> - : int list =
<mlbot> [2; 4; 6; 8; 10; 12; 14; 16; 18; 20; 22; 24; 26; 28; 30; 32; 34; 36; 38; 40;
<mlbot> 42; 44; 46; 48; 50; 52; 54; 56; 58; 60; 62; 64; 66; 68; 70; 72; 74; 76; 78;
<mlbot> 80; 82; 84; 86; 88; 90; 92; 94; 96; 98; 100]
sgwizdak has quit [Success]
sgwizdak has joined #ocaml
<Alpounet> > object end ;;
<mlbot> Symtable.Error(_)
<Alpounet> rr
komar_ has joined #ocaml
jamii_ has quit [Read error: 60 (Operation timed out)]
det has quit [Read error: 104 (Connection reset by peer)]
_andre has joined #ocaml
zbrown has joined #ocaml
mlbot has quit [Remote closed the connection]
willb has joined #ocaml
Ched has quit [Remote closed the connection]
Spiwack has joined #ocaml
jamii_ has joined #ocaml
Ched has joined #ocaml
SirNick has joined #ocaml
seafood has quit []
SirNick has quit []
<palomer> Alpounet, yeah, im continuing my project without JSSP funding
<Alpounet> nice
<palomer> (I have nothing better to do)
<palomer> actually, I do
<palomer> but I don't feel like proving progress/preservation of my (hard) system
<gildor> palomer, Alpounet: I am really curious about what project get selected for this year JSSP
jeremiah has joined #ocaml
fremo has quit [Remote closed the connection]
fremo has joined #ocaml
fremo is now known as Guest94140
Elrood has joined #ocaml
<Alpounet> gildor, me too...
<Alpounet> they must be exceptional
|Jedai| is now known as Jedai
s4tan has quit []
SirNick has joined #ocaml
Ched has quit ["Ex-Chat"]
Ched has joined #ocaml
Ched has quit [Client Quit]
Ched has joined #ocaml
Yoric[DT] has joined #ocaml
_zack has quit ["Leaving."]
lutter has joined #ocaml
Guest94140 is now known as fremo
SirNick has quit []
Camarade_Tux has quit ["Quitte"]
Jedai has quit [Read error: 60 (Operation timed out)]
danbeimborn has left #ocaml []
Andman1 has joined #ocaml
thelema has quit [Read error: 104 (Connection reset by peer)]
Spiwack has quit ["Leaving"]
Jedai has joined #ocaml
Ariens_Hyperion has joined #ocaml
<palomer> hrmph
<palomer> omake doesn't have a manpage
monadic_kid has joined #ocaml
SirNick has joined #ocaml
<flux> not having manual pages sucks :(
Elrood has left #ocaml []
_zack has joined #ocaml
Ariens_Hyperion has quit []
komar_ has quit [Remote closed the connection]
komar_ has joined #ocaml
komar_ has quit [Remote closed the connection]
<flux> hm, this has quite a few things that aren't in the Unix module. I wonder if this is too big to integrate to Batteries.. http://pauillac.inria.fr/cash/latest/doc/Cash.html
<flux> it is not as cleanly divided
<flux> (the almost half-a-megabyte html for a single module is a hint of that ;))
jackie_ has joined #ocaml
<mrvn> lacks phantom types.
<mrvn> FDs can be open for reading and writing so it should be [`Read | `Write ] file_descr
SirNick has quit []
thelema has joined #ocaml
<flux> yes, I was thinking more system-call-wise
Andman1 has left #ocaml []
<flux> but, man, this is what I shall be using in place of writing sh-scripts in the future :-) http://www.ccs.neu.edu/home/tov/code/shcaml/doc/
<flux> I remember reading its announcement quite some time ago, but it seems quite complete - perhaps a bit too complete (witness the reasons behind creating camlish), but can provide type safety too
<palomer> heehee
<palomer> nice
Andman1 has joined #ocaml
Andman1 is now known as Manjor117
Manjor117 is now known as Major117
Major117 is now known as Agent47
Agent47 is now known as YopAndman
YopAndman has left #ocaml []
SirNick has joined #ocaml
mjambon has joined #ocaml
itewsh has joined #ocaml
ttamttam has joined #ocaml
ttamttam has left #ocaml []
_andre has quit ["leaving"]
rwmjones has quit [Read error: 113 (No route to host)]
Ariens_Hyperion has joined #ocaml
Camarade_Tux has joined #ocaml
rwmjones has joined #ocaml
_zack has quit ["Leaving."]
jeddhaberstro has joined #ocaml
slash_ has joined #ocaml
itewsh has quit ["There are only 10 kinds of people: those who understand binary and those who don't"]
Ariens_Hyperion has quit []
<Alpounet> when playing with polymorphic variants
<Alpounet> to get [ `A of x | `B of y ], without > or <, we're obliged to give types explicitly right ?
Jedai has quit [Read error: 113 (No route to host)]
<mrvn> depends
<mrvn> > hmm, or not. damn. I though type inference could produce [ `A ... ] types.
zbrown has left #ocaml []
seafood has joined #ocaml
seafood has quit [Read error: 60 (Operation timed out)]
sOpen has joined #ocaml
<sOpen> Hi, I have a program in which I am right now passing around a state record. I want to modify more than a single field on gets and sets (some fields are dynamic). What's the Right Way to do this? Use an object? A module? Functions over a record?
<mrvn> yes
<mrvn> object is probaly easiest
<sOpen> mrvn, is there any facility for getters and setters? do i need to write all of them?
<sOpen> mrvn, ah! thank you. I understand how to do what i want now. :-)
<Alpounet> mrvn, I've tried.
<sOpen> is there some fundamental difficulty in implementing records? Why do both OCaml and Erlang leak field names?
seafood has joined #ocaml
<mrvn> fields of a record are like any other binding.
<sOpen> mrvn, why? field names aren't used naked, are they? isn't there always a syntactic distinction between field names and other bindings?
<sOpen> seems like unnecessary namespace pollution?
<mrvn> sOpen: x.field makes it infere that x is a record of the type that contains field.
<mrvn> sOpen: how else do you want to detect the type of x?
<sOpen> ah, that would be a good reason
<sOpen> mrvn, why can't a similar trick to objects be done? the type of x is not a record but a record-pattern
<mrvn> sOpen: s#method has the same problem as x.field
<hcarty> sOpen: Object methods have a potential run-time penalty associated with them when compared with records
<sOpen> mrvn, really? don't method names define structural object signatures?
<mrvn> ok, not totally. methods are like hash variants.
<monadic_kid> there are other alternatives to dealing with your state but they aren't easy to grok, in particular functional reactive programming
<sOpen> hcarty, ok... this should be a type checking, static thing, thlugh
<sOpen> monadic_kid, frp isn't right for this... I'm building undo trees
<hcarty> Method lookup is looked up at run-time, since < field : t ... > is an "acceptable" (correct terminology?) type in OCaml, while { field : t ... } is not
<hcarty> s/looked up/performed/
<hcarty> With records everything is determined statically at compile time
<mrvn> < field : t ... > is like `Field of t
<sOpen> monadic_kid, I did see http://code.google.com/p/froc/ though... based on FrTime. What ocaml frp system do you like?
<monadic_kid> I haven't used any yet, i'm still trying to grok it myself ;)
rwmjones has quit [Read error: 104 (Connection reset by peer)]
<hcarty> The OSP 2007 FrGui and underlying library structure seems nice, though perhaps not complete
<mrvn> hcarty: In C++ method lookup is static. I miss that in ocaml.
<mrvn> +possibly
<sOpen> mrvn, I don't understand hash variants, yet. I guess I don't see why { field : t .. } couldn't be a type?
<hcarty> mrvn: I haven't spent much time in C++ recently, thanks to OCaml...
<mrvn> sOpen: it could.
<sOpen> mrvn, so... wouldn't that hoist field names into the type system?
<mrvn> sOpen: But { field : t .. } and { x : int; field : t; ..} would not be compatible. With objects they are.
<sOpen> mrvn, why wouldn't they be compatible? I can pass the second where the first is expected but not vice versa.
<mrvn> sOpen: Because record fields are compile time static offsets.
<mrvn> sOpen: And the first has offset 0 and the second offset 1
<sOpen> mrvn, aha! the sense is making now
<sOpen> now the dynamic method dispatch comment makes sense :-)
<mrvn> Hash variants and object methods have a lookup table using (hash "name")
<mrvn> So the offset doesn't matter, the hash is always the same no matter the position
slash_ has quit [Client Quit]
willb has quit [Read error: 110 (Connection timed out)]
<sOpen> mrvn, hmm... i will need to read more to understand what this entails. At what levels are record field names contained? module? file?
<hcarty> sOpen: Module
<sOpen> hcarty, they are bound to the module, though, right? not forced private? If you open the module, they spill out?
<hcarty> sOpen: Yes, that is correct
<sOpen> hcarty, ok, cool. thanks :-)
<hcarty> module Foo = struct type t = { x : int; y : int } end let it = { Foo.x = 1; y = 1 } ... open Foo let it2 = {x = 1; y = 1}
Yoric[DT] has quit ["Ex-Chat"]
<hcarty> sOpen: It can get odd if you nest a lot of modules and end up with types where have to type things like "it.Foo.bar.Baz.x"
Camarade_Tux has quit ["Quitte"]
monadic_kid has quit ["Leaving"]
<Alpounet> may I bring mlbot ?
<Alpounet> :-p
<hcarty> Alpounet: Certainly!
<hcarty> I think the lack of continuous presence is a large part of what hindered the use of xavierbot
mlbot has joined #ocaml
<Alpounet> here he is
<Alpounet> I'll find a place to put mlbot permanently
<Alpounet> but later
<sOpen> mlbot, hello
<hcarty> Alpounet: Yes, I imagine that would take a bit of preparation
<hcarty> > module Foo = struct type t = { x : int; y : int } end let it = { Foo.x = 1; y = 1 };;
<mlbot> module Foo : sig type t = { x : int; y : int; } end
<mlbot> val it : Foo.t = {Foo.x = 1; Foo.y = 1}
<hcarty> > it.x;;
<mlbot> Type Error
<hcarty> > it.Foo.x;;
<mlbot> - : int = 1
<hcarty> > open Foo it.x;;
<mlbot> Use of ``open'' forbidden
<Alpounet> hcarty, indeed. I have to give him most of OCaml compiler's .cmo, compiled with the same compiler than mlbot...
<Alpounet> > let f = function | `A -> 0 | `B -> 1 ;;
<mlbot> val f : [< `A | `B ] -> int = <fun>
mjambon has left #ocaml []
<Alpounet> > let f2 ( x : [`A | `B] ) = match x with `A -> 0 | `B -> 1 ;;
<mlbot> val f2 : [ `A | `B ] -> int = <fun>
<Alpounet> mrvn, it seems we must do it this way
<Alpounet> (of course, with module interfaces, it is much more practical and readable, as we separate signatures & implementation)
<Alpounet> > f2 `B ;;
<mlbot> - : int = 1
<Alpounet> > f2 `C ;;
<mlbot> Type Error
<Alpounet> > f `C ;;
<mlbot> Type Error
nimred has quit [hubbard.freenode.net irc.freenode.net]
lanaer has quit [hubbard.freenode.net irc.freenode.net]
Ori_B has quit [hubbard.freenode.net irc.freenode.net]
jlouis has quit [hubbard.freenode.net irc.freenode.net]
noj has quit [hubbard.freenode.net irc.freenode.net]
r0bby has quit [hubbard.freenode.net irc.freenode.net]
noj has joined #ocaml
nimred has joined #ocaml
lanaer has joined #ocaml
Ori_B has joined #ocaml
jlouis has joined #ocaml
<Alpounet> oh, I didn't knew about the following.
r0bby has joined #ocaml
<Alpounet> > type variant = [ `A of int | `B of bool ] ;;
<mlbot> type variant = [ `A of int | `B of bool ]
<Alpounet> > let f = function | #variant -> "variant" | _ -> "other" ;;
<mlbot> val f : [> variant ] -> string = <fun>
<Alpounet> f `C ;;
<Alpounet> > f `C ;;
<mlbot> - : string = "other"
<Alpounet> > f (`A 1) ;;
<mlbot> - : string = "variant"
<Alpounet> fun...