gildor changed the topic of #ocaml to: Discussions about the OCaml programming language | http://caml.inria.fr/ | OCaml 3.12.0 http://bit.ly/aNZBUp
clog has joined #ocaml
hto has joined #ocaml
<joelr> thelema: ^
<hcarty> joelr: If you want to use functors, the classes would have to be wrapped in modules (and their names would have to start with lower case letters)
<joelr> oh...
<joelr> i thought i could just pass random types in
<hcarty> In that case you probably want to use functions and/or some OO pieces
<joelr> it seems silly to wrap classes in modules
<joelr> hcarty: i'm stuck with classes as these are generated from thrift-ocaml
<hcarty> I think Jason Hickey's book has a decent chapter on OO vs modules
<joelr> so, why is it that i can do 'class t (i,o) ='
<joelr> but cannot do 'module type X(i, o) = '
<hcarty> Functors are parameterized over modules
<rproust> you can do module X (Y:sig val i: int val o: unit end) = struct ... end
<hcarty> Classes are parameterized over values (and maybe classes?)
<hcarty> Functions are parameterized over all of these, as of 3.12.0
<joelr> rproust: can i do this with module type?
<gildor> joelr: just read what you said before, about oasis
<joelr> gildor: yes?
<gildor> joelr: I think you want something like oasis-db "install" subsystem
<joelr> gildor: would this be local to the project? because i can already install into /usr/local/... with findlib and oasis
<gildor> joelr: i.e. something to manage a set of oasis package, including some for which you are upstream
<joelr> rproust: i need module type X(i,o)
<joelr> basically, parameterize over two types
<gildor> joelr: when you are upstream you can register the directory of the project
<joelr> gildor: i need this for an internal project, private to the client. i reckon oasis-db is something more global, though
<gildor> joelr: and have it rebuild using "oasis update" which will also includes rebuilding project that depends on it
hto has quit [Quit: Lost terminal]
<gildor> joelr: the "install" subsystem is remote for package where you are not upstream and local for your package
<joelr> rproust: docs show examples with 1 type that's a module, though. do i (as hcarty said) need to wrap classes in modules then?
<joelr> gildor: what is being upstream?
<gildor> joelr: e.g. you depend on "extunix", "sqlexpr" and "mylocal1" in project "mylocal2"
ymasory_ has joined #ocaml
<gildor> upstream = you are the author of the project
<gildor> joelr: ^^^
<joelr> ok
<rproust> joelr: module type F = functor (M1 : M) -> N
<joelr> rproust: thanks
<joelr> trying
<gildor> joelr: extunix and sqlexpr will be downloaded from oasis-db whereas mylocal1 will be local
<rproust> joelr: with M a module type containing the specs of your two classes
<gildor> joelr: but this is only a project for now
<gildor> joelr: I am working on it and hopefully, in one month it will be released
<joelr> rproust: does that imply that M needs to be fixed in the signature of the functor or that I can pass that in at runtime? because i'm trying to parameterize over M
<joelr> rproust: here, let me paste this
<rproust> M is static, though M1 is not
<joelr> rproust: ^
<joelr> what i'm trying to do is create a module that can use the request and response classes from any given modules, as well as the read_response and read_request functions
<joelr> rproust: problem is that the latter functions always have the same signature while the classes request and response always have a different set of methods
<rproust> module type INTERFACE = sig class toto : object method foo: unit end end
<rproust> module type FUNCTOR = functor (M1:M) -> sig val read_toto: M1.toto end
<joelr> rproust: i cannot fix M at compile time
<joelr> rproust: see gist above
<joelr> M is known at instantiation time but not in the type signature of the functor
<rproust> it doesn't have to
<joelr> rproust: so i can literally say (M1:M)?
<rproust> M can be dynamuic, but M1 is fixed at compile time
<joelr> i see...
<rproust> mo
<rproust> the other way around
<thelema> joelr: module type Reader = sig type req type resp val read_request: Protocol.t -> req val read_response: Protocol.t -> resp end
<rproust> M is the interface that needs to be known at compile time
<joelr> rproust: what thelema said :) i just hit on it the very same moment
<joelr> :D
<joelr> is there a way to specify a class type that has at least a write method of a given signature, e.g. to avoid this error
<joelr> Error: This expression has type E.response but an expression was expected of type < write : TBinaryProtocol.t -> 'a; .. >
<thelema> type response = <write : TBinaryProtocol.t -> 'a; .. >
Yoric has joined #ocaml
<joelr> ha! just like that
<joelr> thelema: thanks
<jld> Doesn't that need to be more like type 'a t = < m : whatever; .. > as 'a ?
<joelr> 'a = unit, e.g. in the original class
<joelr> method write : Protocol.t -> unit
<joelr> damn, i'm wrong :(
<joelr> Error: A type variable is unbound in this type declaration. In type < write : TBinaryProtocol.t -> unit; .. > as 'a the variable 'a is unbound
<thelema> maybe even more than that - ('a, 'b) t = <write : t -> 'a; ..> as 'b
<joelr> class response : object ('a) method write : Protocol.t -> unit end
<joelr> thelema: ^ this is the definition of response
<joelr> there are other methods of ocurse
<thelema> the other option is to just downcast your object that does more than write
<thelema> of course this means you can't use any of those other methods on the downcast object
<joelr> thelema: let me try with ('a) t = first
<joelr> so if i write this
<joelr> sig
<joelr> type request
<joelr> type ('a) response = <write : TBinaryProtocol.t -> unit; .. > as 'a
<joelr> type ('a) request = < write : TBinaryProtocol.t -> unit; .. > as 'a
Cyanure has quit [Read error: Operation timed out]
<joelr> are these two distinctive 'a or should i use 'a and 'b to distinguish
<thelema> two distinct
<joelr> great
yezariaely has joined #ocaml
hto has joined #ocaml
<joelr> one last question... assuming i have
<joelr> module type Endpoint =
<joelr> sig
<joelr> type ('a) request = < write : TBinaryProtocol.t -> unit; .. > as 'a
<joelr> type ('a) response = <write : TBinaryProtocol.t -> unit; .. > as 'a
<joelr> how do i do this?
<joelr> module Ads =
<joelr> struct
<joelr> type request = T.request (D.document)
<joelr> type response = T.response (D.document)
<thelema> you probably don't want to define types, but values.
tauntaun has joined #ocaml
<joelr> thelema: the issue is that request, for example, is defined like this class request : object ('a) ...
<thelema> module type E = sig val request : <write: t -> unit; ..> as 'a val response <write: t -> unit; ..> as 'a end
<joelr> thelema: so i need to get hold of that A somehow when implementing module Endpoint
Fullma has quit [Ping timeout: 255 seconds]
<thelema> I don't think so - that 'a is just so you can refer to the type of request within itself
<joelr> let me paste the error then
<thelema> It looks more and more like you don't need a functor, just two objects as parameters
<joelr> thelema: the modules where the objects live also have 2 functions that i need
<thelema> n/m then
<joelr> thelema: just updated Endpoint with https://gist.github.com/884046
<thelema> you have "type request = T.request" in your sig?
<joelr> err,
<joelr> thelema: check gist again, just updated it
<joelr> thelema: let me add the definition
<thelema> you don't need ('a) - the parentheses are only needed if you have multiple type parameters
<joelr> thelema: updated
<joelr> removing parens
<thelema> "different arities" refers to the number of type parameters
<thelema> 'a request has arity 1
<thelema> request has arity 0
<thelema> try: type 'a request = T.request as 'a
<joelr> thelema: updated gist one last time with the module where the classes and read_request, etc. live
<joelr> check
<joelr> thelema: that gives this: https://gist.github.com/884061
<joelr> still a signature mismatch
<thelema> looks like you'll have to cast down.
<joelr> thelema: really?
<thelema> or...
<thelema> your requirements for 'a request and 'a response are just that they are objects with a write method, right?
schmrkc has quit [Ping timeout: 240 seconds]
<joelr> right
<thelema> if this is the case, you don't need them in your functor at all.
<joelr> thelema: ?
<thelema> not in your functor parameter
<joelr> here, i summarized what i'm doing here: https://gist.github.com/884072
<thelema> put a writable type outside both the functor sig and the functor body
<joelr> thelema: please take a look
<thelema> I see it.\
<thelema> remove request and response from Endpoint
<thelema> put "type 'a writable = < write : TBinaryProtocol.t -> unit; .. > as 'a" before endpoint
<joelr> and change the sig of read_request and read_response?
<thelema> yes
<joelr> trying
yezariaely has quit [Quit: Leaving.]
<joelr> thelema: i'm doing something wrong, clearly https://gist.github.com/884077
<thelema> you dropped the 'a from request
<thelema> from all the return values. You still need that
<joelr> err, skip that
<thelema> request has to be a unit function, not directly an object (or a type)
<joelr> thelema: like this: https://gist.github.com/884086
<thelema> let request () = ...
<joelr> thelema: thanks. seems like i'm progressing. thanks a lot!
<joelr> thelema: last one, hopefully: https://gist.github.com/884097
<joelr> <- is a quick learner
<joelr> this one seems some stupid mistake on my end
<joelr> can't figure out which one, though, as my request is clearly a function
<joelr> val request : unit -> 'a writable
<joelr> thelema: sorry, ignore that
<joelr> scratch, forget
<joelr> thelema: this one https://gist.github.com/884097
<joelr> still fighting the type system
<thelema> what's the type of t.request?
<joelr> it's saying that my T.request is not a writable, although it does have a write method defined as method write : Protocol.t -> unit
<thelema> is Protocol.t = TBinaryProtocol.t?
<joelr> thelema: top here https://gist.github.com/884072
<joelr> yes, it is
ygrek has quit [Ping timeout: 246 seconds]
<thelema> what happens if you remove the TBinary part of 'a writable?
<joelr> checking
ulfdoz has quit [Read error: Operation timed out]
<joelr> doesn't work. Values do not match: val request : unit -> T.request is not included in val request : unit -> < write : Thrift.Protocol.t -> unit; .. > U.writable
<thelema> ok, try a cast: let request () = (new T.request :> 'a U.writable)
<joelr> is that :>
<joelr> yes
<thelema> YES
<thelema> (oops, didn't mean to shout)
<thelema> looks like you might have to lose the 'a and set [type writable = <write: Thrift.Protocol.t -> unit>]
<thelema> I don't know how to fix this.
<joelr> will try, thanks for your help
schmrkc has joined #ocaml
schmrkc has quit [Changing host]
schmrkc has joined #ocaml
<joelr> thelema: btw, i don't think i can loose the 'a. In type < write : Thrift.Protocol.t -> unit; .. > as 'a the variable 'a is unbound
<thelema> yes, you have to lose the ;.. too
<joelr> interesting, let me try that
<thelema> this is the downcasting solution, where you convert your objects to the lowest common denominator type
<joelr> thelema: doesn't work for me as there are other methods of the class that i'm using
<joelr> i suppose they are not just writable ... hmm
<thelema> yup.
<thelema> if there's other methods you need, you'll have to require them.
<joelr> you mean include them in the signature of writable?
<thelema> yes
edwin has quit [Remote host closed the connection]
philtor has joined #ocaml
Yoric has quit [Quit: Yoric]
tauntaun has quit [Quit: Ex-Chat]
philtor has quit [Ping timeout: 248 seconds]
smerz has quit [Remote host closed the connection]
<joelr> thelema: here's a self-contained example that can be compiled with ocamlc https://gist.github.com/884212 much simpler, hopefully
<joelr> still doesn't work :-(
sepp2k has quit [Ping timeout: 255 seconds]
sepp2k has joined #ocaml