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 quit [Read error: 110 (Connection timed out)]
vuln has joined #ocaml
Fullma` has joined #ocaml
aij has joined #ocaml
Fullma has quit [Read error: 113 (No route to host)]
ched_ has joined #ocaml
ched__ has quit [Read error: 110 (Connection timed out)]
kate__ has quit [Read error: 110 (Connection timed out)]
<aij> I have a funny question: In ocaml it is traditional to name a type that would be the same as the module it's in "t" (eg: Hashtbl.t, Int64.t, String.t). What name would you use if t were a class type rather than a type?
<mrvn> t
<mrvn> # module M = struct class t = object end end;;
<mrvn> module M : sig class t : object end end
<mrvn> aij: Anything wrong with using that?
<mrvn> # let x = new M.t;;
<aij> mrvn: nope, I was just wondering what the convention was
<mrvn> val x : M.t = <obj>
<mrvn> I think / hope M.t is quite standard.
<mrvn> Although I haven't seen any module that is based on a class type yet.
hsuh has joined #ocaml
<mrvn> # module M : sig type t end = struct class t = object end end;;
<mrvn> module M : sig type t end
<aij> mrvn: yeah, there are classes in /usr/lib/ocaml/3.10.2 but no modules that are really based on a type...
<mrvn> You can hide the class too I think.
<aij> s/type/class/
<mrvn> # module M : sig type t val make : unit -> t end = struct class t = object end let make () = new t end;;
<mrvn> module M : sig type t val make : unit -> t end
<mrvn> # let x = M.make ();;
<mrvn> val x : M.t = <abstr>
<mrvn> With a hidden class type you can not use "new M.t".
<aij> mrvn: yeah, I know how to use ocaml :)
<mrvn> :)
<mrvn> aij: Next question: What do you name the types if a module as more than one?
<aij> generally something sensible...
<mrvn> both or do you pick one for "t" and the other gets a full name?
<aij> if the module they're is called M, and one type would otherwise be called m, I would probably call that type t and give the other one a full name
<mrvn> My gut says that if one is used 90% of the time it should be t but if it is 50/50 then two destinct names are in order.
<thelema> mrvn: more details?
<thelema> what are your two types, and what does the module provide?
prime2 has joined #ocaml
<mrvn> could be anything.
<thelema> if there's really two types provided by the module, splitting the module might be in order.
<mrvn> Say I split the Unix module putting all the file releated stuff into Unix.File then I would use Unix.File.t as file descriptor and Unix.File.open_flags and Unix.File.seek_command.
<thelema> yes, there's definitely a sense of 'main type' involved in all operations there.
<mrvn> yep.
<aij> thelema: well, I wouldn't call that "main type" so much as "file type"
<thelema> which is why I'd say that if there's no 'main type', one might want to think about your module design
<aij> but, eh, I guess either way makes sense
<mrvn> you could have 2 recursive types.
<mrvn> aij: main as in every Unix.File functions either takes or returns one.
seafood has joined #ocaml
<mrvn> Hmm, is there something like OO.id but for 'a -> int?
<thelema> mrvn: a unique identifier for an arbitrary type?
<mrvn> yep.
<thelema> there's many functions with type ['a -> int] : (fun _ -> 3)
<thelema> how could you unique-id two ints?
<mrvn> .oO( But they are not like Oo.id :)
<thelema> equal ints.
kate__ has joined #ocaml
<mrvn> Say id <int> = 0 then id 1 = 0 and id 2 = 0.
<thelema> for boxed types, this is easy (although you have to bit-shift the pointer to fit ocaml ints)
<mrvn> I really want it for the type and not the contents.
<thelema> for the type? ocaml values have no type at runtime.
<mrvn> thelema: yeah, that is the problem.
<mrvn> Doesn't have to work for all types. Just have to build something to id a small set of types.
<aij> mrvn: why do you need runtime types?
seafood has quit []
<mrvn> trying something with a heterogenous container.
<aij> ack
<aij> use python :)
<thelema> mrvn: there's some ways to embed the universal type into ocaml's type system...
<mrvn> A simple approach would be let next_id = ref 0 let alloc_id = let id = !next_id in incr next_id; id
<mrvn> And then every type for the container has to alloc one.
<aij> mrvn: how would you tell when you want to allocate a different type though?
<mrvn> thelema: I want a "let find_all : <type id> -> <type> list" function.
<mrvn> aij: what do you mean?
<mrvn> aij: Every M.t would have an M.id
<mrvn> Actually what I want is let find_all : 'a <type id> -> 'a list
<mrvn> The type of <type id> has to be somehow intertwined with the value it then internaly has so that it will be unique for every 'a.
<mrvn> Maybe something like class virtual ['a] type_id = object method virtual id : int end;; and then in the modules type t class my_id = object inherit [t] type_id method id = alloc_id () end
seafood has joined #ocaml
seafood has quit [Client Quit]
sgnb has quit [Remote closed the connection]
sgnb has joined #ocaml
AxleLonghorn has joined #ocaml
<AxleLonghorn> does anyone know the associated cost with creating a module instance?
<mrvn> AxleLonghorn: like callsing String.create 10?
<AxleLonghorn> no, like creating a functor, then applying it all over the place
<mrvn> I believe functors are completly compile time constructs. They optimize right out.
<AxleLonghorn> so that you have `module Foo = Bar(Baz)` and `module Foo2 = Bar(Bazz)` and `module Foo3 = Bar(Bazzz)` all over the place, say 20 times
<AxleLonghorn> is there an increase in memory usage or binary size?
<thelema> mrvn: sadly, there is a runtime overhead to functors.
<thelema> mrvn: thus the defunctorization filters for earlier versions of ocaml
<palomer> I remember Dr. Garrigue saying something about how functors aren't being as fast as I thought
<mrvn> thelema: but const for a single or 1000 invocations.
<AxleLonghorn> what's the overhead? a constant factor?
* thelema doesn't know exactly the overhead, but would be surprised if it were more than a constant added to functorized function invocation
<mrvn> Isn't it the same overhead as for a closure call?
<thelema> it could be.
<mrvn> Can I write a functor (Mod : MOD) -> sig <sig of Mod> val foo : something end?
<mrvn> Where the signature of Mod is larger than MOD.
<thelema> ?? Yes, you can pass as a functor argument a super-type (module-wise) than its parameter...
AxleLonghorn has quit [Read error: 60 (Operation timed out)]
<mrvn> thelema: but can I retain that superset of functions and values in the output of the functor?
<thelema> for instance, we have an Int module in batteries that has much more than the .t and .compare needed for Set / Map, but it can be used as an argument to the functor
<thelema> oh, now I see your question...
<thelema> I think no.
<thelema> your functor output has a particular signature, I can't see how it can have more functions in it if you pass a more complex argument.
<mrvn> I think functor is just the wrong keyword. How can I include one module in another?
<mrvn> *patsch* 'include M' does the trick.
<thelema> module Y = struct include Foo end
<mrvn> Was thinking way to complex.
seafood_ has joined #ocaml
AxleLonghorn has joined #ocaml
AxleLonghorn has left #ocaml []
AxleLonghorn has joined #ocaml
<mrvn> module rec M : sig type t val type_id : t C.type_id end = struct type t module Id = TypeId(M) include Id
<mrvn> end
<mrvn> :((((
<mrvn> Error: Cannot safely evaluate the definition of the recursively-defined module M
<mrvn> http://paste.debian.net/32783/ How is that for having a runtime mapping from type to id?
AxleLonghorn has left #ocaml []
AxleLonghorn has joined #ocaml
ygrek has quit [Remote closed the connection]
<aij> mrvn: is that any better than: let r = ref 0 module TypeId = functor (M : sig type t end) -> struct let type_id = let id = !r in r := id+1; id end
<aij> (ie: incrementing a counter for each instantiation of the functor)
vuln has quit ["leaving"]
<mrvn> aij: The 'a type_id intertwines the 'a with the id.
<mrvn> aij: You can write let find_all : 'a type_id -> 'a list
<aij> mrvn: wow, trying to add the type_id type to mine causes: This expression has type int but is here used with type M.t type_id = int
<aij> mrvn: for some reason, if I ascribe the type in the module signature it is ok though...
<aij> type 'a type_id = int
<aij> let r = ref 0
<aij> module TypeId = functor (M : sig type t end) -> (
<aij> struct
<aij> let type_id = let id = !r in r := id+1; id
<aij> end : sig val type_id : M.t type_id end)
ygrek has joined #ocaml
hsuh has quit [Read error: 104 (Connection reset by peer)]
<mrvn> aij: Here is the reason why I used a class instead of int: http://paste.debian.net/32784/
<mrvn> aij: A record with encode/decode closures would work too though.
seafood has joined #ocaml
<mrvn> type 'a id = { id : int; encode : 'a -> (int, Obj.t); decode : (int, Obj.t) -> 'a option }
<aij> ok, that's a lot like the universal type module thelema pointed at, except using functors and exposing the unique id for each type
<mrvn> http://paste.debian.net/32785/ the same with a record
<mrvn> aij: The difference is that you can find_all. The Universal type thelema pointed to can't do that as the "embed" is specific to a single value and not its type.
<aij> well, embed() could return (id,put,get)
<mrvn> aij: nope.
<aij> (for some of the implementations)
seafood_ has quit [Read error: 110 (Connection timed out)]
<mrvn> aij: one could combine my TypeID with the (put, get) to get both working though.
<aij> actually, even without exposing the id, couldn't you use prj as an id to pass to find_all (assuming you didn't require it to be a concrete type)
<mrvn> prj?
<aij> err, same as the get function
<aij> (the second function in the pair returned by embed() )
<mrvn> The get function is bound to one specific ref value.
<aij> yes, which is why you could use it as a sort of id
<mrvn> aij: But every value you store has its unique get function. I have an ID that is identical for all values of a given type.
<aij> no, you only need to call embed() once for each type
<aij> (much like you call C.TypeId for each type)
<mrvn> aij: let (put, get) = embed () in put 1; put 2; get ()?
<aij> no, get takes one of the values that put returned
<aij> basically, get is the same as your decode, and put is the same as your encode
kate__ has quit [Connection timed out]
<aij> let (put, get) = embed () in let a = put 1 and b = put 2 in (get a, get b) should evaluate to (1,2)
<mrvn> I see what you mean
<aij> err (Some 1, Some 2)
* aij needs to catch up on sleep :P
<mrvn> # let a = put 1;;
<mrvn> # let b = put 2;;
<mrvn> # List.map get [a;b];;
<mrvn> - : int option list = [Some 1; Some 2]
seafood has quit []
AxleLonghorn has left #ocaml []
prime2 has quit ["leaving"]
Yoric[DT] has joined #ocaml
seafood has joined #ocaml
seafood has quit []
ygrek_ has joined #ocaml
ygrek has quit [Remote closed the connection]
Yoric[DT] has quit ["Ex-Chat"]
pants1 has joined #ocaml
sOpen has joined #ocaml
<sOpen> i'm still learning ocaml... is there a way to write point-free functions?
<aij> mrvn: yes, it would be more interesting if you call embed() twice so you can use the two sets of functions on different types
<aij> sOpen: do you mean like let f x = x*x ?
pants1 has quit ["Leaving."]
<sOpen> aij, I mean like (Haskell) f = 2 *
m3ga has quit ["disappearing into the sunset"]
<sOpen> aij, let f = ( * ) 2 works fine... trying to define right associativity now
<mrvn> aij: The difficult part is to get embed () to always return the same pair of functions for the same type.
slash_ has joined #ocaml
Alpounet has joined #ocaml
<sOpen> are match's patterns special cases? is it possible to use a bound variable as a pattern?
<mrvn> match with x when x = variable ->
<sOpen> mrvn, ! guards... i didn't realize they could be used, thanks
<sOpen> mrvn, sorry to ask a stupid question... i now see it in the manual
Camarade_Tux has quit [Read error: 110 (Connection timed out)]
Camarade_Tux has joined #ocaml
s4tan has joined #ocaml
ygrek_ has quit [Remote closed the connection]
s4tan has quit [Read error: 60 (Operation timed out)]
s4tan has joined #ocaml
komar_ has joined #ocaml
jedai has quit ["KVIrc 3.4.0 Virgo http://www.kvirc.net/"]
_zack has joined #ocaml
jedai has joined #ocaml
ygrek_ has joined #ocaml
Mr_Awesome has quit ["aunt jemima is the devil!"]
rwmjones_ has joined #ocaml
ygrek_ has quit [Remote closed the connection]
kaustuv_ has quit [Read error: 110 (Connection timed out)]
OChameau has joined #ocaml
rwmjones_ has quit ["Closed connection"]
Spiwack has joined #ocaml
jeanbon has joined #ocaml
sparta has joined #ocaml
fremo_ has joined #ocaml
sOpen has quit [Read error: 110 (Connection timed out)]
fremo has quit [Read error: 110 (Connection timed out)]
fremo_ is now known as fremo
verte has quit ["λ"]
jeanbon has quit ["J'y trouve un goût d'pomme."]
th5 has joined #ocaml
hkBst has joined #ocaml
<Alpounet> it is also on Google Code and SF, but no file anywhere, nor doc.
<mrvn> Why does "loop left; fn (k, v); loop right" give (fn : ('a * 'b -> 'c))? Shouldn't it say 'c = unit or give a warning that fn returns 'c instead of unit?
<Alpounet> You can write : loop left; fn (k, v) : unit; loop right
<Alpounet> BTW : # let rec f (a,b) = () ; f (a-1, b-1) ; () ;;
<Alpounet> val f : int * int -> unit = <fun>
<mrvn> sure. But normaly ocaml warns if one drops a return type != unit.
<mrvn> Alpounet: Because the last () sets the return type of f
<Alpounet> yes
<Alpounet> that's the same for you
<Alpounet> loop returns 'c
<mrvn> Nope, loop returns Nil -> ()
<Alpounet> but OCaml should warn here yep.
<Alpounet> Oh.
<mrvn> loop and fn are 2 functions.
<Alpounet> yes, but as loop right is the last instruction, it normally determines the return type.
<Alpounet> Even if having fn (k,v) at the middle seems to indicate it should be unit.
<mrvn> it determines the return type of loop, not of fn.
<mrvn> let iter tree (fn : ('c * 'd) -> unit) = let rec loop = function Nil -> () | Node(left, k, v, _, right) -> loop left; fn (k, v); loop right in loop tree
<mrvn> val iter : ('a, 'b) t -> ('a * 'b -> unit) -> unit
<mrvn> FYI, loop left; fn (k, v) : unit; loop right doesn't work. Has to be ((fn (k, v)) : unit); which is rather ugly.
<Alpounet> Yes...
<mrvn> type ('a, 'b, 'c, 'd) type_id = { encoder : 'a * 'b -> 'c * 'd; decoder : 'c * 'd -> 'a * 'b;
<mrvn> }
<mrvn> I think I never had a quadrupel polmorphic type before.
<Alpounet> Cheers
<mrvn> And I still don't. type ('a, 'b) type_id = { encoder : 'a -> 'b; decoder : 'b -> 'a; } works just as well.
<Alpounet> It's more general.
<mrvn> val insert : ('a, 'b) t -> ('c * 'd, 'a * 'b) type_id -> 'c * 'd -> ('a, 'b) t
<mrvn> val find : ('a, 'b) t -> ('c, 'a * 'b) type_id -> 'a -> 'c
<mrvn> val find_le : ('a, 'b) t -> ('c, 'a * 'b) type_id -> 'a -> 'c
<mrvn> Not much.
<Alpounet> Heh :-)
<Alpounet> Wouldn't it be better to put the "pair type" constraint in type_id directly, rather than on everything that uses it ?
<mrvn> val insert : ('a, 'b) t -> ('c, 'a * 'b) type_id -> 'c -> ('a, 'b) t
<mrvn> There. all better now.
<mrvn> It is 'a * 'b because the tree stores key value pairs. Doesn't have to be for the type_id. maybe I will reuse that somewhere else too.
<Alpounet> Ok :-)
<mrvn> by the way, how would I put the pair constraint in the type?
<mrvn> type (('a * 'b), ('c * 'd) type_id doesn't work
<mrvn> type ('a, 'b) type_id constraint 'a = 'e * 'f constraint 'b = 'c * 'd. Now that is ever worse than ('a, 'b, 'c, 'd) type_id
<mrvn> If one could I would write type ('a, 'b) kv = ('a 'b * 'a).
<Spiwack> You can write the latter by functorizing 'b
<Spiwack> But it might not be what you're looking for
<Alpounet> type ('a, 'b, 'c, 'd) type_id = { encoder : 'a * 'b -> 'c * 'd; decoder : 'c * 'd -> 'a * 'b } is fien IMO
<Alpounet> fine*
<Alpounet> if it is the behavior you're looking for, of course.
<mrvn> I just call it as type t type kv_here = (t key, t) kv
<mrvn> Spiwack: functors would just make more work.
<Spiwack> Well it definitely depends on the application you have in mind
<mrvn> The code works for any ('a * 'b). It is just my use case that uses 'a key where 'a is a phantom type for the value part.
<mrvn> Now there is one function I don't really like yet: http://paste.debian.net/32823/
<mrvn> I could encode that as a closure into the key/value pairs but that would eat 32 bytes per entry or so.
<Alpounet> How many entries does it aim at supporting, on average ?
<mrvn> One entry per inode, one per directory entry, one per x 4k blocks and one per ~1G or disk space probably.
<Alpounet> ok
<Alpounet> ok
<mrvn> But they are in a BTree so only the needed parts will be loaded.
<grirgz> hi
<mrvn> Are small functors inside a module inlined and optimized away?
<grirgz> i've installed godi and mikmatch_pcre with godi_console but i don't understand how i can use mikmatch in my program, when i type "#require "mikmatch_pcre";;" in toplevel it says : "No such package: mikmatch_pcre"
<Spiwack> you probably want to use findlib
<Spiwack> (though I don't know how it interacts with the toplevel)
<Spiwack> but the simplest (not necessarily most robust) solution would be to use #directory "directory/where/mikmatch/is" before your require
<grirgz> how findlib know to look in the godi directory ?
<Spiwack> I don't know, but it does look there for certain
<grirgz> but mikmatch is not on the list "ocamlfind list"
<Spiwack> Ouch
<grirgz> i'm lost :p
<grirgz> never used godi before
<Spiwack> I've never used mikmatch :)
<Spiwack> You need someone more experienced than I am, I guess
<grirgz> does godi make a new install of all ocaml files (compilers, std libs, etc) ?
<grirgz> so i should remove the system one ? (debian)
<Spiwack> it does
<mrvn> mixing the two is not a good idea
<grirgz> ok, now i understand =)
<Alpounet> what system do you use ?
<grirgz> debian sid
<Alpounet> The Debian OCaml team does a very good job. You can get ocaml 3.11 and other recent packages easily
<Alpounet> e.g, aptitude install ocaml on testing or unstable will install ocaml 3.11 :-)
<grirgz> yes, in fact, ocaml work fine, but i've tested mikmatch and it doest work well (the macros was not recognised) so i decided to try godi
<Alpounet> oh...
sparta has quit [Read error: 104 (Connection reset by peer)]
<grirgz> but it don't work better with GODI :/
<_zack> grirgz: well, you could have reported the bug to the Debian bug tracking system ...
<grirgz> i don't know what is the bug for the moment
<grirgz> maybe i have not done something right
<grirgz> and mikmatch have no debian package
<mrvn> You could always package it. :)
<grirgz> first, i will try to make it work =)
sparta has joined #ocaml
<palomer> which cvs snapshot is it?
<grirgz> it's mikmatch-1.0.1.tar.gz
<palomer> I mean ocaml 3.11
<grirgz> 3.11.0 from the debian package
det_ is now known as det
<grirgz> mmm, in fact the problem is not so serious, it's just the toplevel wich dont show return value when no variable are affected
palomer has quit [Remote closed the connection]
<thelema> grirgz: example?
sparta has quit [Read error: 104 (Connection reset by peer)]
<thelema> gotcha.
<mrvn> odd
<grirgz> another strange thing : work interactively but not scripted http://pastebin.com/m4d9e47cf
<grirgz> can you confirm i didnt make mistake ?
<mrvn> I never use the toplevel like that. I just use ocamlc.
komar__ has joined #ocaml
<mrvn> % wc *.ml
<mrvn> 2758 12412 78755 total
<mrvn> this is slowly getting big.
<Alpounet> 2415 11962 78544 total
olegfink has quit [Read error: 104 (Connection reset by peer)]
olegfink has joined #ocaml
olegfink is now known as Guest6195
<s4tan> hi guys, there is some compiler switch that permit to show the filename and row number when an exception is throw?
<mrvn> OCAMLRUNPARAM="b=0x1" or something
<s4tan> many tnx mrvn : )
<s4tan> i will try it
Guest6195 has quit [Read error: 104 (Connection reset by peer)]
Guest6195 has joined #ocaml
komar_ has quit [Read error: 110 (Connection timed out)]
wsmith84 has joined #ocaml
<wsmith84> quick question
<wsmith84> How do I enable the Caml extension that adds [< and >] to the syntax?
<wsmith84> (Been reading the OReilly book online and they use it but .. no mention of how to enable it. ocaml doesn't parse it by default IINM.)
<gildor> wsmith84: this is parser syntax ?
<gildor> wsmith84: if this is the case, just use -pp camlp4o
<Alpounet> it's stream syntax.
RowanD has joined #ocaml
jackie_ has joined #ocaml
<gildor> (Alpounet: I use it mainly when building parser with Genlex, don't know when you can use it otherwise)
<Alpounet> (I use it only for parsing stuffs too, but that's the "official name", heh)
buzz0r_ has joined #ocaml
jeanbon has joined #ocaml
Gooffy has joined #ocaml
Gooffy has left #ocaml []
buzz0r_ has quit [Read error: 104 (Connection reset by peer)]
sparta has joined #ocaml
willb has joined #ocaml
jeanb-- has joined #ocaml
jeanbon has quit [Nick collision from services.]
jeanb-- is now known as jeanbon
komar__ has quit [Remote closed the connection]
komar__ has joined #ocaml
Amorphous has quit [Read error: 110 (Connection timed out)]
s4tan has quit []
Amorphous has joined #ocaml
jackie_ has quit [Client Quit]
th5 has quit []
gildor has quit [Read error: 104 (Connection reset by peer)]
gildor has joined #ocaml
wsmith84 has quit [Read error: 60 (Operation timed out)]
_zack has quit ["Leaving."]
jonafan_ has joined #ocaml
jonafan has quit [Nick collision from services.]
jonafan_ is now known as jonafan
Spiwack has quit [Remote closed the connection]
OChameau has quit ["Leaving"]
mfp has quit [Read error: 104 (Connection reset by peer)]
kaustuv_ has joined #ocaml
mfp has joined #ocaml
jeanb-- has joined #ocaml
jeanbon has quit [Nick collision from services.]
jeanb-- is now known as jeanbon
jeremiah has quit [Read error: 104 (Connection reset by peer)]
sparta has quit [Read error: 104 (Connection reset by peer)]
th5 has joined #ocaml
palomer has joined #ocaml
<palomer> anyone know the complexity of buffer#get_text?
<Camarade_Tux> # ?
jeremiah has joined #ocaml
<palomer> ??
<Camarade_Tux> I mean, where is this from ?
<flux> palomer, likely O(n)?
<palomer> that's a bummer
<palomer> isn't it O(1) in gtk?
<palomer> Camarade_Tux, lablgtk
<flux> palomer, I imagine it would need to copy a gtk string for it to be usable in ocaml
<flux> also, gc issues..
<palomer> bummer!
<flux> what are you doing if the time buffer#get_text takes matters?
<palomer> I plan to do something like buffer#changed ~callback:(fun _ -> foo := buffer#get_text)
<palomer> buffer#connect#changed, that is
<palomer> I'm writing a domain specific language to encapsulate a very small portion of the capabilities of lablgtk
<Camarade_Tux> palomer, you could look at lablgtk's source or create a 16MB buffer in lablgtk, check the memory usage, use #get_text and then check again the memory usage
<Camarade_Tux> if it hasn't changed, it's O(1), otherwise...
<flux> perhaps you can have your own buffer widget that would not have the problem
<palomer> http://pastebin.com/mdd99823 <--here is (part) my domain specific language definition
<palomer> (part) of
<palomer> so now I have to change my `Text of string ref to something else
<flux> palomer, did you take a look at frgui, btw?
<palomer> flux, not yet, is it really worth looking at?
<flux> yes
<palomer> got a direct url?
<palomer> I heard someone say that it's on the jane street page
<palomer> can't find it there
Mr_Awesome has joined #ocaml
<flux> I've got mine checked out from http://users.wpi.edu/~squirrel/repos/ocamlrt2 (darcs)
<flux> dunno if there is something more recent elsewhere
RowanD has quit [Read error: 110 (Connection timed out)]
<flux> heh, I suppose it's gone (clip from google): "..used to be located at http://users.wpi.edu/~squirrel/repos/ocamlrt2 but recently vanished. The.."
<flux> last changeset on dec 2006..
<flux> the darcs one is more recent
<flux> I can put it online if you want
<palomer> but I first want to learn about it before I start using it
<flux> read the examples :)
<flux> I don't know if it's usable, but I think you are going into the same direction
<palomer> http://pastebin.com/m6861917e <--here's my wrapped and efficient version of `Text
<palomer> flux, what's the darcs command to fetch?
<flux> darcs get
<palomer> hah, it's the same as what I'm doing
<palomer> BUT
<flux> ..there's always a but..
<palomer> I'm constantly reorganizing and redrawing my widgets
<palomer> and I have (lots) of code to make sure I make as few changes as possible to the actual widgets
<palomer> furthermore, my widgets are never destroyed
<palomer> I only see one demo...
<palomer> I wish I could get a better understanding of frgui
<palomer> through documentation
cDlm has joined #ocaml
<flux> it does appear the project has been abandoned
Ariens_Hyperion has joined #ocaml
<flux> "Wow, I'm glad OCamlRT was useful for someone. I gave up working on it about a year ago at the behest of my advisor ("who uses OCaml?"). FWIW I've moved the sources (along with myself) to http://cs.brown.edu/~squirrel/temp/ocamlrt2.tgz, since at least a few people seem to miss it."
<palomer> his supervisor told him to stop?
<palomer> bastard.
<cDlm> supervisors can be a bit pointy haired
<cDlm> http://eigenclass.org/hiki/fp-ocaml-koans <- what about the 1st one, couldn't all lets be let recs ?
<cDlm> are non-recursive definitions compiled really differently than a recursive def without recursive calls ?
<thelema> no, rec just changes scoping rules for bindings.
<palomer> not to mention changes the meaning of and
jamii__ has quit [Connection timed out]
<palomer> hrmph
<cDlm> and is used elsewhere ?
<palomer> let b = false;; let rec a = true and b = false in a && b;;let a = true and b = false in a&&b;;
<palomer> in those two statements, and means different things
<palomer> imagine trying to debug one of these errors!
<cDlm> hmf
<thelema> palomer: yes, that's one weakness of ocaml's syntax...
<cDlm> my ocaml is rusty
<thelema> isn't [and] as boolean op depreciated?
<palomer> ocaml doesn't complain
<palomer> maybe with -Wall
<palomer> lemme check
<palomer> err
<Camarade_Tux> I can confirm it is
<Camarade_Tux> (deprecated that is)
<cDlm> true and false;; doesnt parse
<Camarade_Tux> hmmm, or was it single &
<palomer> err
<palomer> weird
<palomer> the interpreter accepts it
<palomer> but not the compiler
<cDlm> but yeah, and as let rec separator, and as successive definitions in a let in
<cDlm> I tried in the interpreter
<cDlm> wait, toplevel
<cDlm> anyway, thanks for the clarification
jeanb-- has joined #ocaml
jeanbon has quit [Nick collision from services.]
jeanb-- is now known as jeanbon
sgnb has quit [Read error: 104 (Connection reset by peer)]
sgnb has joined #ocaml
Guest6195 has quit ["WeeChat 0.2.6.1"]
cads has joined #ocaml
<cads> hey, what's let rec do?
<cads> and how's it differ from just a plain let
itewsh has joined #ocaml
<cads> oh, recursive let
buzz0r_ has joined #ocaml
jeanbon has quit ["EOF"]
fred___ has joined #ocaml
fred___ has quit [Client Quit]
rhar has joined #ocaml
<Alpounet> good night all ;-)
Alpounet has quit ["Ex-Chat"]
mishok13 has quit [Read error: 60 (Operation timed out)]
sOpen has joined #ocaml
th5 has quit []
mishok13 has joined #ocaml
itewsh has quit ["There are only 10 kinds of people: those who understand binary and those who don't"]
verte has joined #ocaml
ched_ is now known as Ched
buzz0r_ has quit [Read error: 104 (Connection reset by peer)]
seafood has joined #ocaml
<palomer> I remember when I was young and stupid, I didn't understand why rec wasn't recursive by default
<palomer> and then I found a very good reason
<palomer> and then I forgot it
<brendan> you might not always want to shadow an outer definition I suppose
^authentic has joined #ocaml
willb has quit [Read error: 110 (Connection timed out)]
cads has quit [Connection timed out]
buzz0r_ has joined #ocaml
<palomer> nono, there's an even better reason
seafood has quit []
authentic has quit [No route to host]
^authentic is now known as authentic
seafood has joined #ocaml
m3ga has joined #ocaml
seafood has quit []
Ariens_Hyperion has quit []
<mattam> palomer: value restriction?
buzz0r_ has quit ["Ex-Chat"]